home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / UNIXTOOL / GNU / PERL / PERL5SRC.ZIP / !Perl / c / pp_sys < prev    next >
Encoding:
Text File  |  1995-06-29  |  70.6 KB  |  3,925 lines
  1. /*    pp_sys.c
  2.  *
  3.  *    Copyright (c) 1991-1994, Larry Wall
  4.  *
  5.  *    You may distribute under the terms of either the GNU General Public
  6.  *    License or the Artistic License, as specified in the README file.
  7.  *
  8.  *
  9.  
  10.  *
  11.  * But only a short way ahead its floor and the walls on either side were
  12.  * cloven by a great fissure, out of which the red glare came, now leaping
  13.  * up, now dying down into darkness; and all the while far below there was
  14.  * a rumour and a trouble as of great engines throbbing and labouring.
  15.  */
  16.  
  17. #include "EXTERN.h"
  18. #include "perl.h"
  19.  
  20. /* Omit this -- it causes too much grief on mixed systems.
  21. #ifdef I_UNISTD
  22. #include <unistd.h>
  23. #endif
  24.  
  25. */
  26. /* Put this after #includes because fork and vfork prototypes may
  27.    conflict.
  28. */
  29. #ifndef HAS_VFORK
  30. #   define vfork fork
  31. #endif
  32.  
  33. #if defined(HAS_SOCKET) && !defined(VMS) /* VMS handles sockets via vmsish.h */
  34. # include <sys/socket.h>
  35. # include <netdb.h>
  36. # ifndef ENOTSOCK
  37. #  ifdef I_NET_ERRNO
  38. #   include <net/errno.h>
  39. #  endif
  40. # endif
  41. #endif
  42.  
  43. #ifdef HAS_SELECT
  44. #ifdef I_SYS_SELECT
  45. #ifndef I_SYS_TIME
  46. #include <sys/select.h>
  47. #endif
  48. #endif
  49. #endif
  50.  
  51. #ifdef HOST_NOT_FOUND
  52. extern int h_errno;
  53. #endif
  54.  
  55. #ifdef HAS_PASSWD
  56. # ifdef I_PWD
  57. #  include <pwd.h>
  58. # else
  59.     struct passwd *getpwnam _((char *));
  60.     struct passwd *getpwuid _((Uid_t));
  61. # endif
  62.   struct passwd *getpwent _((void));
  63. #endif
  64.  
  65. #ifdef HAS_GROUP
  66. # ifdef I_GRP
  67. #  include <grp.h>
  68. # else
  69.     struct group *getgrnam _((char *));
  70.     struct group *getgrgid _((Gid_t));
  71. # endif
  72.     struct group *getgrent _((void));
  73. #endif
  74.  
  75. #ifdef I_UTIME
  76. #include <utime.h>
  77. #endif
  78. #ifdef I_FCNTL
  79. #include <fcntl.h>
  80. #endif
  81. #ifdef I_SYS_FILE
  82. #include <sys/file.h>
  83. #endif
  84.  
  85. #ifdef HAS_GETPGRP2
  86. #   define getpgrp getpgrp2
  87. #endif
  88.  
  89. #ifdef HAS_SETPGRP2
  90. #   define setpgrp setpgrp2
  91. #endif
  92.  
  93. #if !defined(HAS_MKDIR) || !defined(HAS_RMDIR)
  94. static int dooneliner _((char *cmd, char *filename));
  95. #endif
  96. /* Pushy I/O. */
  97.  
  98. PP(pp_backtick)
  99. {
  100.     dSP; dTARGET;
  101.     FILE *fp;
  102.     char *tmps = POPp;
  103.     TAINT_PROPER("``");
  104.     fp = my_popen(tmps, "r");
  105.     if (fp) {
  106.     sv_setpv(TARG, "");    /* note that this preserves previous buffer */
  107.     if (GIMME == G_SCALAR) {
  108.         while (sv_gets(TARG, fp, SvCUR(TARG)) != Nullch)
  109.         /*SUPPRESS 530*/
  110.         ;
  111.         XPUSHs(TARG);
  112.     }
  113.     else {
  114.         SV *sv;
  115.  
  116.         for (;;) {
  117.         sv = NEWSV(56, 80);
  118.         if (sv_gets(sv, fp, 0) == Nullch) {
  119.             SvREFCNT_dec(sv);
  120.             break;
  121.         }
  122.         XPUSHs(sv_2mortal(sv));
  123.         if (SvLEN(sv) - SvCUR(sv) > 20) {
  124.             SvLEN_set(sv, SvCUR(sv)+1);
  125.             Renew(SvPVX(sv), SvLEN(sv), char);
  126.         }
  127.         }
  128.     }
  129.     statusvalue = my_pclose(fp);
  130.     }
  131.     else {
  132.     statusvalue = -1;
  133.     if (GIMME == G_SCALAR)
  134.         RETPUSHUNDEF;
  135.     }
  136.  
  137.     RETURN;
  138. }
  139.  
  140. PP(pp_glob)
  141. {
  142.     OP *result;
  143.     ENTER;
  144.     SAVEINT(rschar);
  145.     SAVEINT(rslen);
  146.  
  147.     SAVESPTR(last_in_gv);    /* We don't want this to be permanent. */
  148.     last_in_gv = (GV*)*stack_sp--;
  149.  
  150.     rslen = 1;
  151. #ifdef DOSISH
  152.     rschar = 0;
  153. #else
  154. #ifdef CSH
  155.     rschar = 0;
  156. #else
  157.     rschar = '\n';
  158. #endif    /* !CSH */
  159. #endif    /* !MSDOS */
  160.     result = do_readline();
  161.     LEAVE;
  162.     return result;
  163. }
  164.  
  165. PP(pp_indread)
  166. {
  167.     last_in_gv = gv_fetchpv(SvPVx(GvSV((GV*)(*stack_sp--)), na), TRUE,SVt_PVIO);
  168.     return do_readline();
  169. }
  170.  
  171. PP(pp_rcatline)
  172. {
  173.     last_in_gv = cGVOP->op_gv;
  174.     return do_readline();
  175. }
  176.  
  177. PP(pp_warn)
  178. {
  179.     dSP; dMARK;
  180.     char *tmps;
  181.     if (SP - MARK != 1) {
  182.     dTARGET;
  183.     do_join(TARG, &sv_no, MARK, SP);
  184.     tmps = SvPV(TARG, na);
  185.     SP = MARK + 1;
  186.     }
  187.     else {
  188.     tmps = SvPV(TOPs, na);
  189.     }
  190.     if (!tmps || !*tmps) {
  191.     SV *error = GvSV(gv_fetchpv("@", TRUE, SVt_PV));
  192.     (void)SvUPGRADE(error, SVt_PV);
  193.     if (SvPOK(error) && SvCUR(error))
  194.         sv_catpv(error, "\t...caught");
  195.     tmps = SvPV(error, na);
  196.     }
  197.     if (!tmps || !*tmps)
  198.     tmps = "Warning: something's wrong";
  199.     warn("%s", tmps);
  200.     RETSETYES;
  201. }
  202.  
  203. PP(pp_die)
  204. {
  205.     dSP; dMARK;
  206.     char *tmps;
  207.     if (SP - MARK != 1) {
  208.     dTARGET;
  209.     do_join(TARG, &sv_no, MARK, SP);
  210.     tmps = SvPV(TARG, na);
  211.     SP = MARK + 1;
  212.     }
  213.     else {
  214.     tmps = SvPV(TOPs, na);
  215.     }
  216.     if (!tmps || !*tmps) {
  217.     SV *error = GvSV(gv_fetchpv("@", TRUE, SVt_PV));
  218.     (void)SvUPGRADE(error, SVt_PV);
  219.     if (SvPOK(error) && SvCUR(error))
  220.         sv_catpv(error, "\t...propagated");
  221.     tmps = SvPV(error, na);
  222.     }
  223.     if (!tmps || !*tmps)
  224.     tmps = "Died";
  225.     DIE("%s", tmps);
  226. }
  227.  
  228. /* I/O. */
  229.  
  230. PP(pp_open)
  231. {
  232.     dSP; dTARGET;
  233.     GV *gv;
  234.     SV *sv;
  235.     char *tmps;
  236.     STRLEN len;
  237.  
  238.     if (MAXARG > 1)
  239.     sv = POPs;
  240.     else
  241.     sv = GvSV(TOPs);
  242.     gv = (GV*)POPs;
  243.     tmps = SvPV(sv, len);
  244.     if (do_open(gv, tmps, len,Nullfp)) {
  245.     IoLINES(GvIOp(gv)) = 0;
  246.     PUSHi( (I32)forkprocess );
  247.     }
  248.     else if (forkprocess == 0)        /* we are a new child */
  249.     PUSHi(0);
  250.     else
  251.     RETPUSHUNDEF;
  252.     RETURN;
  253. }
  254.  
  255. PP(pp_close)
  256. {
  257.     dSP;
  258.     GV *gv;
  259.  
  260.     if (MAXARG == 0)
  261.     gv = defoutgv;
  262.     else
  263.     gv = (GV*)POPs;
  264.     EXTEND(SP, 1);
  265.     PUSHs( do_close(gv, TRUE) ? &sv_yes : &sv_no );
  266.     RETURN;
  267. }
  268.  
  269. PP(pp_pipe_op)
  270. {
  271.     dSP;
  272. #ifdef HAS_PIPE
  273.     GV *rgv;
  274.     GV *wgv;
  275.     register IO *rstio;
  276.     register IO *wstio;
  277.     int fd[2];
  278.  
  279.     wgv = (GV*)POPs;
  280.     rgv = (GV*)POPs;
  281.  
  282.     if (!rgv || !wgv)
  283.     goto badexit;
  284.  
  285.     rstio = GvIOn(rgv);
  286.     wstio = GvIOn(wgv);
  287.  
  288.     if (IoIFP(rstio))
  289.     do_close(rgv, FALSE);
  290.     if (IoIFP(wstio))
  291.     do_close(wgv, FALSE);
  292.  
  293.     if (pipe(fd) < 0)
  294.     goto badexit;
  295.  
  296.     IoIFP(rstio) = fdopen(fd[0], "r");
  297.     IoOFP(wstio) = fdopen(fd[1], "w");
  298.     IoIFP(wstio) = IoOFP(wstio);
  299.     IoTYPE(rstio) = '<';
  300.     IoTYPE(wstio) = '>';
  301.  
  302.     if (!IoIFP(rstio) || !IoOFP(wstio)) {
  303.     if (IoIFP(rstio)) fclose(IoIFP(rstio));
  304.     else close(fd[0]);
  305.     if (IoOFP(wstio)) fclose(IoOFP(wstio));
  306.     else close(fd[1]);
  307.     goto badexit;
  308.     }
  309.  
  310.     RETPUSHYES;
  311.  
  312. badexit:
  313.     RETPUSHUNDEF;
  314. #else
  315.     DIE(no_func, "pipe");
  316. #endif
  317. }
  318.  
  319. PP(pp_fileno)
  320. {
  321.     dSP; dTARGET;
  322.     GV *gv;
  323.     IO *io;
  324.     FILE *fp;
  325.     if (MAXARG < 1)
  326.     RETPUSHUNDEF;
  327.     gv = (GV*)POPs;
  328.     if (!gv || !(io = GvIO(gv)) || !(fp = IoIFP(io)))
  329.     RETPUSHUNDEF;
  330.     PUSHi(fileno(fp));
  331.     RETURN;
  332. }
  333.  
  334. PP(pp_umask)
  335. {
  336.     dSP; dTARGET;
  337.     int anum;
  338.  
  339. #ifdef HAS_UMASK
  340.     if (MAXARG < 1) {
  341.     anum = umask(0);
  342.     (void)umask(anum);
  343.     }
  344.     else
  345.     anum = umask(POPi);
  346.     TAINT_PROPER("umask");
  347.     XPUSHi(anum);
  348. #else
  349.     DIE(no_func, "Unsupported function umask");
  350. #endif
  351.     RETURN;
  352. }
  353.  
  354. PP(pp_binmode)
  355. {
  356.     dSP;
  357.     GV *gv;
  358.     IO *io;
  359.     FILE *fp;
  360.  
  361.     if (MAXARG < 1)
  362.     RETPUSHUNDEF;
  363.  
  364.     gv = (GV*)POPs;
  365.  
  366.     EXTEND(SP, 1);
  367.     if (!(io = GvIO(gv)) || !(fp = IoIFP(io)))
  368.     RETSETUNDEF;
  369.  
  370. #ifdef DOSISH
  371. #ifdef atarist
  372.     if (!fflush(fp) && (fp->_flag |= _IOBIN))
  373.     RETPUSHYES;
  374.     else
  375.     RETPUSHUNDEF;
  376. #else
  377.     if (setmode(fileno(fp), OP_BINARY) != -1)
  378.     RETPUSHYES;
  379.     else
  380.     RETPUSHUNDEF;
  381. #endif
  382. #else
  383.     RETPUSHYES;
  384. #endif
  385. }
  386.  
  387. PP(pp_tie)
  388. {
  389.     dSP;
  390.     SV *varsv;
  391.     HV* stash;
  392.     GV *gv;
  393.     BINOP myop;
  394.     SV *sv;
  395.     SV **mark = stack_base + ++*markstack_ptr;    /* reuse in entersub */
  396.     I32 markoff = mark - stack_base - 1;
  397.     char *methname;
  398.  
  399.     varsv = mark[0];
  400.     if (SvTYPE(varsv) == SVt_PVHV)
  401.     methname = "TIEHASH";
  402.     else if (SvTYPE(varsv) == SVt_PVAV)
  403.     methname = "TIEARRAY";
  404.     else if (SvTYPE(varsv) == SVt_PVGV)
  405.     methname = "TIEHANDLE";
  406.     else
  407.     methname = "TIESCALAR";
  408.  
  409.     stash = gv_stashsv(mark[1], FALSE);
  410.     if (!stash || !(gv = gv_fetchmethod(stash, methname)) || !GvCV(gv))
  411.     DIE("Can't locate object method \"%s\" via package \"%s\"",
  412.         methname, SvPV(mark[1],na));
  413.  
  414.     Zero(&myop, 1, BINOP);
  415.     myop.op_last = (OP *) &myop;
  416.     myop.op_next = Nullop;
  417.     myop.op_flags = OPf_KNOW|OPf_STACKED;
  418.  
  419.     ENTER;
  420.     SAVESPTR(op);
  421.     op = (OP *) &myop;
  422.  
  423.     XPUSHs(gv);
  424.     PUTBACK;
  425.  
  426.     if (op = pp_entersub())
  427.         run();
  428.     SPAGAIN;
  429.  
  430.     sv = TOPs;
  431.     if (sv_isobject(sv)) {
  432.     if (SvTYPE(varsv) == SVt_PVHV || SvTYPE(varsv) == SVt_PVAV) {
  433.         sv_unmagic(varsv, 'P');
  434.         sv_magic(varsv, sv, 'P', Nullch, 0);
  435.     }
  436.     else {
  437.         sv_unmagic(varsv, 'q');
  438.         sv_magic(varsv, sv, 'q', Nullch, 0);
  439.     }
  440.     }
  441.     LEAVE;
  442.     SP = stack_base + markoff;
  443.     PUSHs(sv);
  444.     RETURN;
  445. }
  446.  
  447. PP(pp_untie)
  448. {
  449.     dSP;
  450.     if (SvTYPE(TOPs) == SVt_PVHV || SvTYPE(TOPs) == SVt_PVAV)
  451.     sv_unmagic(TOPs, 'P');
  452.     else
  453.     sv_unmagic(TOPs, 'q');
  454.     RETSETYES;
  455. }
  456.  
  457. PP(pp_dbmopen)
  458. {
  459.     dSP;
  460.     HV *hv;
  461.     dPOPPOPssrl;
  462.     HV* stash;
  463.     GV *gv;
  464.     BINOP myop;
  465.     SV *sv;
  466.  
  467.     hv = (HV*)POPs;
  468.  
  469.     sv = sv_mortalcopy(&sv_no);
  470.     sv_setpv(sv, "AnyDBM_File");
  471.     stash = gv_stashsv(sv, FALSE);
  472.     if (!stash || !(gv = gv_fetchmethod(stash, "TIEHASH")) || !GvCV(gv)) {
  473.     PUTBACK;
  474.     perl_requirepv("AnyDBM_File.pm");
  475.     SPAGAIN;
  476.     if (!(gv = gv_fetchmethod(stash, "TIEHASH")) || !GvCV(gv))
  477.         DIE("No dbm on this machine");
  478.     }
  479.  
  480.     Zero(&myop, 1, BINOP);
  481.     myop.op_last = (OP *) &myop;
  482.     myop.op_next = Nullop;
  483.     myop.op_flags = OPf_KNOW|OPf_STACKED;
  484.  
  485.     ENTER;
  486.     SAVESPTR(op);
  487.     op = (OP *) &myop;
  488.     PUTBACK;
  489.     pp_pushmark();
  490.  
  491.     EXTEND(sp, 5);
  492.     PUSHs(sv);
  493.     PUSHs(left);
  494.     if (SvIV(right))
  495.     PUSHs(sv_2mortal(newSViv(O_RDWR|O_CREAT)));
  496.     else
  497.     PUSHs(sv_2mortal(newSViv(O_RDWR)));
  498.     PUSHs(right);
  499.     PUSHs(gv);
  500.     PUTBACK;
  501.  
  502.     if (op = pp_entersub())
  503.         run();
  504.     SPAGAIN;
  505.  
  506.     if (!sv_isobject(TOPs)) {
  507.     sp--;
  508.     op = (OP *) &myop;
  509.     PUTBACK;
  510.     pp_pushmark();
  511.  
  512.     PUSHs(sv);
  513.     PUSHs(left);
  514.     PUSHs(sv_2mortal(newSViv(O_RDONLY)));
  515.     PUSHs(right);
  516.     PUSHs(gv);
  517.     PUTBACK;
  518.  
  519.     if (op = pp_entersub())
  520.         run();
  521.     SPAGAIN;
  522.     }
  523.  
  524.     if (sv_isobject(TOPs))
  525.     sv_magic((SV*)hv, TOPs, 'P', Nullch, 0);
  526.     LEAVE;
  527.     RETURN;
  528. }
  529.  
  530. PP(pp_dbmclose)
  531. {
  532.     return pp_untie(ARGS);
  533. }
  534.  
  535. PP(pp_sselect)
  536. {
  537.     dSP; dTARGET;
  538. #ifdef HAS_SELECT
  539.     register I32 i;
  540.     register I32 j;
  541.     register char *s;
  542.     register SV *sv;
  543.     double value;
  544.     I32 maxlen = 0;
  545.     I32 nfound;
  546.     struct timeval timebuf;
  547.     struct timeval *tbuf = &timebuf;
  548.     I32 growsize;
  549.     char *fd_sets[4];
  550. #if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
  551.     I32 masksize;
  552.     I32 offset;
  553.     I32 k;
  554.  
  555. #   if BYTEORDER & 0xf0000
  556. #    define ORDERBYTE (0x88888888 - BYTEORDER)
  557. #   else
  558. #    define ORDERBYTE (0x4444 - BYTEORDER)
  559. #   endif
  560.  
  561. #endif
  562.  
  563.     SP -= 4;
  564.     for (i = 1; i <= 3; i++) {
  565.     if (!SvPOK(SP[i]))
  566.         continue;
  567.     j = SvCUR(SP[i]);
  568.     if (maxlen < j)
  569.         maxlen = j;
  570.     }
  571.  
  572. #if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678
  573.     growsize = maxlen;        /* little endians can use vecs directly */
  574. #else
  575. #ifdef NFDBITS
  576.  
  577. #ifndef NBBY
  578. #define NBBY 8
  579. #endif
  580.  
  581.     masksize = NFDBITS / NBBY;
  582. #else
  583.     masksize = sizeof(long);    /* documented int, everyone seems to use long */
  584. #endif
  585.     growsize = maxlen + (masksize - (maxlen % masksize));
  586.     Zero(&fd_sets[0], 4, char*);
  587. #endif
  588.  
  589.     sv = SP[4];
  590.     if (SvOK(sv)) {
  591.     value = SvNV(sv);
  592.     if (value < 0.0)
  593.         value = 0.0;
  594.     timebuf.tv_sec = (long)value;
  595.     value -= (double)timebuf.tv_sec;
  596.     timebuf.tv_usec = (long)(value * 1000000.0);
  597.     }
  598.     else
  599.     tbuf = Null(struct timeval*);
  600.  
  601.     for (i = 1; i <= 3; i++) {
  602.     sv = SP[i];
  603.     if (!SvOK(sv)) {
  604.         fd_sets[i] = 0;
  605.         continue;
  606.     }
  607.     else if (!SvPOK(sv))
  608.         SvPV_force(sv,na);    /* force string conversion */
  609.     j = SvLEN(sv);
  610.     if (j < growsize) {
  611.         Sv_Grow(sv, growsize);
  612.         s = SvPVX(sv) + j;
  613.         while (++j <= growsize) {
  614.         *s++ = '\0';
  615.         }
  616.     }
  617. #if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
  618.     s = SvPVX(sv);
  619.     New(403, fd_sets[i], growsize, char);
  620.     for (offset = 0; offset < growsize; offset += masksize) {
  621.         for (j = 0, k=ORDERBYTE; j < masksize; j++, (k >>= 4))
  622.         fd_sets[i][j+offset] = s[(k % masksize) + offset];
  623.     }
  624. #else
  625.     fd_sets[i] = SvPVX(sv);
  626. #endif
  627.     }
  628.  
  629.     nfound = select(
  630.     maxlen * 8,
  631.     (Select_fd_set_t) fd_sets[1],
  632.     (Select_fd_set_t) fd_sets[2],
  633.     (Select_fd_set_t) fd_sets[3],
  634.     tbuf);
  635.     for (i = 1; i <= 3; i++) {
  636.     if (fd_sets[i]) {
  637.         sv = SP[i];
  638. #if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
  639.         s = SvPVX(sv);
  640.         for (offset = 0; offset < growsize; offset += masksize) {
  641.         for (j = 0, k=ORDERBYTE; j < masksize; j++, (k >>= 4))
  642.             s[(k % masksize) + offset] = fd_sets[i][j+offset];
  643.         }
  644.         Safefree(fd_sets[i]);
  645. #endif
  646.         SvSETMAGIC(sv);
  647.     }
  648.     }
  649.  
  650.     PUSHi(nfound);
  651.     if (GIMME == G_ARRAY && tbuf) {
  652.     value = (double)(timebuf.tv_sec) +
  653.         (double)(timebuf.tv_usec) / 1000000.0;
  654.     PUSHs(sv = sv_mortalcopy(&sv_no));
  655.     sv_setnv(sv, value);
  656.     }
  657.     RETURN;
  658. #else
  659.     DIE("select not implemented");
  660. #endif
  661. }
  662.  
  663. PP(pp_select)
  664. {
  665.     dSP; dTARGET;
  666.     GV *oldgv = defoutgv;
  667.     if (op->op_private > 0) {
  668.     defoutgv = (GV*)POPs;
  669.     if (!GvIO(defoutgv))
  670.         gv_IOadd(defoutgv);
  671.     }
  672.     gv_efullname(TARG, oldgv);
  673.     XPUSHTARG;
  674.     RETURN;
  675. }
  676.  
  677. PP(pp_getc)
  678. {
  679.     dSP; dTARGET;
  680.     GV *gv;
  681.  
  682.     if (MAXARG <= 0)
  683.     gv = stdingv;
  684.     else
  685.     gv = (GV*)POPs;
  686.     if (!gv)
  687.     gv = argvgv;
  688.     if (!gv || do_eof(gv)) /* make sure we have fp with something */
  689.     RETPUSHUNDEF;
  690.     TAINT_IF(1);
  691.     sv_setpv(TARG, " ");
  692.     *SvPVX(TARG) = getc(IoIFP(GvIOp(gv))); /* should never be EOF */
  693.     PUSHTARG;
  694.     RETURN;
  695. }
  696.  
  697. PP(pp_read)
  698. {
  699.     return pp_sysread(ARGS);
  700. }
  701.  
  702. static OP *
  703. doform(cv,gv,retop)
  704. CV *cv;
  705. GV *gv;
  706. OP *retop;
  707. {
  708.     register CONTEXT *cx;
  709.     I32 gimme = GIMME;
  710.     AV* padlist = CvPADLIST(cv);
  711.     SV** svp = AvARRAY(padlist);
  712.  
  713.     ENTER;
  714.     SAVETMPS;
  715.  
  716.     push_return(retop);
  717.     PUSHBLOCK(cx, CXt_SUB, stack_sp);
  718.     PUSHFORMAT(cx);
  719.     SAVESPTR(curpad);
  720.     curpad = AvARRAY((AV*)svp[1]);
  721.  
  722.     defoutgv = gv;        /* locally select filehandle so $% et al work */
  723.     return CvSTART(cv);
  724. }
  725.  
  726. PP(pp_enterwrite)
  727. {
  728.     dSP;
  729.     register GV *gv;
  730.     register IO *io;
  731.     GV *fgv;
  732.     CV *cv;
  733.  
  734.     if (MAXARG == 0)
  735.     gv = defoutgv;
  736.     else {
  737.     gv = (GV*)POPs;
  738.     if (!gv)
  739.         gv = defoutgv;
  740.     }
  741.     EXTEND(SP, 1);
  742.     io = GvIO(gv);
  743.     if (!io) {
  744.     RETPUSHNO;
  745.     }
  746.     if (IoFMT_GV(io))
  747.     fgv = IoFMT_GV(io);
  748.     else
  749.     fgv = gv;
  750.  
  751.     cv = GvFORM(fgv);
  752.  
  753.     if (!cv) {
  754.     if (fgv) {
  755.         SV *tmpsv = sv_newmortal();
  756.         gv_efullname(tmpsv, gv);
  757.         DIE("Undefined format \"%s\" called",SvPVX(tmpsv));
  758.     }
  759.     DIE("Not a format reference");
  760.     }
  761.     IoFLAGS(io) &= ~IOf_DIDTOP;
  762.  
  763.     return doform(cv,gv,op->op_next);
  764. }
  765.  
  766. PP(pp_leavewrite)
  767. {
  768.     dSP;
  769.     GV *gv = cxstack[cxstack_ix].blk_sub.gv;
  770.     register IO *io = GvIOp(gv);
  771.     FILE *ofp = IoOFP(io);
  772.     FILE *fp;
  773.     SV **newsp;
  774.     I32 gimme;
  775.     register CONTEXT *cx;
  776.  
  777.     DEBUG_f(fprintf(stderr,"left=%ld, todo=%ld\n",
  778.       (long)IoLINES_LEFT(io), (long)FmLINES(formtarget)));
  779.     if (IoLINES_LEFT(io) < FmLINES(formtarget) &&
  780.     formtarget != toptarget)
  781.     {
  782.     if (!IoTOP_GV(io)) {
  783.         GV *topgv;
  784.         char tmpbuf[256];
  785.  
  786.         if (!IoTOP_NAME(io)) {
  787.         if (!IoFMT_NAME(io))
  788.             IoFMT_NAME(io) = savepv(GvNAME(gv));
  789.         sprintf(tmpbuf, "%s_TOP", IoFMT_NAME(io));
  790.         topgv = gv_fetchpv(tmpbuf,FALSE, SVt_PVFM);
  791.         if ((topgv && GvFORM(topgv)) ||
  792.           !gv_fetchpv("top",FALSE,SVt_PVFM))
  793.             IoTOP_NAME(io) = savepv(tmpbuf);
  794.         else
  795.             IoTOP_NAME(io) = savepv("top");
  796.         }
  797.         topgv = gv_fetchpv(IoTOP_NAME(io),FALSE, SVt_PVFM);
  798.         if (!topgv || !GvFORM(topgv)) {
  799.         IoLINES_LEFT(io) = 100000000;
  800.         goto forget_top;
  801.         }
  802.         IoTOP_GV(io) = topgv;
  803.     }
  804.     if (IoFLAGS(io) & IOf_DIDTOP) {    /* Oh dear.  It still doesn't fit. */
  805.         I32 lines = IoLINES_LEFT(io);
  806.         char *s = SvPVX(formtarget);
  807.         while (lines-- > 0) {
  808.         s = strchr(s, '\n');
  809.         if (!s)
  810.             break;
  811.         s++;
  812.         }
  813.         if (s) {
  814.         fwrite1(SvPVX(formtarget), s - SvPVX(formtarget), 1, ofp);
  815.         sv_chop(formtarget, s);
  816.         FmLINES(formtarget) -= IoLINES_LEFT(io);
  817.         }
  818.     }
  819.     if (IoLINES_LEFT(io) >= 0 && IoPAGE(io) > 0)
  820.         fwrite1(SvPVX(formfeed), SvCUR(formfeed), 1, ofp);
  821.     IoLINES_LEFT(io) = IoPAGE_LEN(io);
  822.     IoPAGE(io)++;
  823.     formtarget = toptarget;
  824.     IoFLAGS(io) |= IOf_DIDTOP;
  825.     return doform(GvFORM(IoTOP_GV(io)),gv,op);
  826.     }
  827.  
  828.   forget_top:
  829.     POPBLOCK(cx,curpm);
  830.     POPFORMAT(cx);
  831.     LEAVE;
  832.  
  833.     fp = IoOFP(io);
  834.     if (!fp) {
  835.     if (dowarn) {
  836.         if (IoIFP(io))
  837.         warn("Filehandle only opened for input");
  838.         else
  839.         warn("Write on closed filehandle");
  840.     }
  841.     PUSHs(&sv_no);
  842.     }
  843.     else {
  844.     if ((IoLINES_LEFT(io) -= FmLINES(formtarget)) < 0) {
  845.         if (dowarn)
  846.         warn("page overflow");
  847.     }
  848.     if (!fwrite1(SvPVX(formtarget), 1, SvCUR(formtarget), ofp) ||
  849.         ferror(fp))
  850.         PUSHs(&sv_no);
  851.     else {
  852.         FmLINES(formtarget) = 0;
  853.         SvCUR_set(formtarget, 0);
  854.         *SvEND(formtarget) = '\0';
  855.         if (IoFLAGS(io) & IOf_FLUSH)
  856.         (void)fflush(fp);
  857.         PUSHs(&sv_yes);
  858.     }
  859.     }
  860.     formtarget = bodytarget;
  861.     PUTBACK;
  862.     return pop_return();
  863. }
  864.  
  865. PP(pp_prtf)
  866. {
  867.     dSP; dMARK; dORIGMARK;
  868.     GV *gv;
  869.     IO *io;
  870.     FILE *fp;
  871.     SV *sv = NEWSV(0,0);
  872.  
  873.     if (op->op_flags & OPf_STACKED)
  874.     gv = (GV*)*++MARK;
  875.     else
  876.     gv = defoutgv;
  877.     if (!(io = GvIO(gv))) {
  878.     if (dowarn) {
  879.         gv_fullname(sv,gv);
  880.         warn("Filehandle %s never opened", SvPV(sv,na));
  881.     }
  882.     SETERRNO(EBADF,RMS$_IFI);
  883.     goto just_say_no;
  884.     }
  885.     else if (!(fp = IoOFP(io))) {
  886.     if (dowarn)  {
  887.         gv_fullname(sv,gv);
  888.         if (IoIFP(io))
  889.         warn("Filehandle %s opened only for input", SvPV(sv,na));
  890.         else
  891.         warn("printf on closed filehandle %s", SvPV(sv,na));
  892.     }
  893.     SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
  894.     goto just_say_no;
  895.     }
  896.     else {
  897.     do_sprintf(sv, SP - MARK, MARK + 1);
  898.     if (!do_print(sv, fp))
  899.         goto just_say_no;
  900.  
  901.     if (IoFLAGS(io) & IOf_FLUSH)
  902.         if (fflush(fp) == EOF)
  903.         goto just_say_no;
  904.     }
  905.     SvREFCNT_dec(sv);
  906.     SP = ORIGMARK;
  907.     PUSHs(&sv_yes);
  908.     RETURN;
  909.  
  910.   just_say_no:
  911.     SvREFCNT_dec(sv);
  912.     SP = ORIGMARK;
  913.     PUSHs(&sv_undef);
  914.     RETURN;
  915. }
  916.  
  917. PP(pp_sysread)
  918. {
  919.     dSP; dMARK; dORIGMARK; dTARGET;
  920.     int offset;
  921.     GV *gv;
  922.     IO *io;
  923.     char *buffer;
  924.     int length;
  925.     int bufsize;
  926.     SV *bufsv;
  927.     STRLEN blen;
  928.  
  929.     gv = (GV*)*++MARK;
  930.     if (!gv)
  931.     goto say_undef;
  932.     bufsv = *++MARK;
  933.     buffer = SvPV_force(bufsv, blen);
  934.     length = SvIVx(*++MARK);
  935.     if (length < 0)
  936.     DIE("Negative length");
  937.     SETERRNO(0,0);
  938.     if (MARK < SP)
  939.     offset = SvIVx(*++MARK);
  940.     else
  941.     offset = 0;
  942.     io = GvIO(gv);
  943.     if (!io || !IoIFP(io))
  944.     goto say_undef;
  945. #ifdef HAS_SOCKET
  946.     if (op->op_type == OP_RECV) {
  947.     bufsize = sizeof buf;
  948.     buffer = SvGROW(bufsv, length+1);
  949.     length = recvfrom(fileno(IoIFP(io)), buffer, length, offset,
  950.         (struct sockaddr *)buf, &bufsize);
  951.     if (length < 0)
  952.         RETPUSHUNDEF;
  953.     SvCUR_set(bufsv, length);
  954.     *SvEND(bufsv) = '\0';
  955.     (void)SvPOK_only(bufsv);
  956.     SvSETMAGIC(bufsv);
  957.     if (tainting)
  958.         sv_magic(bufsv, Nullsv, 't', Nullch, 0);
  959.     SP = ORIGMARK;
  960.     sv_setpvn(TARG, buf, bufsize);
  961.     PUSHs(TARG);
  962.     RETURN;
  963.     }
  964. #else
  965.     if (op->op_type == OP_RECV)
  966.     DIE(no_sock_func, "recv");
  967. #endif
  968.     buffer = SvGROW(bufsv, length+offset+1);
  969.     if (op->op_type == OP_SYSREAD) {
  970. #ifdef RISCOS
  971.     length = fread(buffer+offset,1,length,IoIFP(io));
  972. #else
  973.     length = read(fileno(IoIFP(io)), buffer+offset, length);
  974. #endif
  975.     }
  976.     else
  977. #ifdef HAS_SOCKET__bad_code_maybe
  978.     if (IoTYPE(io) == 's') {
  979.     bufsize = sizeof buf;
  980.     length = recvfrom(fileno(IoIFP(io)), buffer+offset, length, 0,
  981.         (struct sockaddr *)buf, &bufsize);
  982.     }
  983.     else
  984. #endif
  985.     length = fread(buffer+offset, 1, length, IoIFP(io));
  986.     if (length < 0)
  987.     goto say_undef;
  988.     SvCUR_set(bufsv, length+offset);
  989.     *SvEND(bufsv) = '\0';
  990.     (void)SvPOK_only(bufsv);
  991.     SvSETMAGIC(bufsv);
  992.     if (tainting)
  993.     sv_magic(bufsv, Nullsv, 't', Nullch, 0);
  994.     SP = ORIGMARK;
  995.     PUSHi(length);
  996.     RETURN;
  997.  
  998.   say_undef:
  999.     SP = ORIGMARK;
  1000.     RETPUSHUNDEF;
  1001. }
  1002.  
  1003. PP(pp_syswrite)
  1004. {
  1005.     return pp_send(ARGS);
  1006. }
  1007.  
  1008. PP(pp_send)
  1009. {
  1010.     dSP; dMARK; dORIGMARK; dTARGET;
  1011.     GV *gv;
  1012.     IO *io;
  1013.     int offset;
  1014.     SV *bufsv;
  1015.     char *buffer;
  1016.     int length;
  1017.     STRLEN blen;
  1018.  
  1019.     gv = (GV*)*++MARK;
  1020.     if (!gv)
  1021.     goto say_undef;
  1022.     bufsv = *++MARK;
  1023.     buffer = SvPV(bufsv, blen);
  1024.     length = SvIVx(*++MARK);
  1025.     if (length < 0)
  1026.     DIE("Negative length");
  1027.     SETERRNO(0,0);
  1028.     io = GvIO(gv);
  1029.     if (!io || !IoIFP(io)) {
  1030.     length = -1;
  1031.     if (dowarn) {
  1032.         if (op->op_type == OP_SYSWRITE)
  1033.         warn("Syswrite on closed filehandle");
  1034.         else
  1035.         warn("Send on closed socket");
  1036.     }
  1037.     }
  1038.     else if (op->op_type == OP_SYSWRITE) {
  1039.     if (MARK < SP)
  1040.         offset = SvIVx(*++MARK);
  1041.     else
  1042.         offset = 0;
  1043.     if (length > blen - offset)
  1044.         length = blen - offset;
  1045. #ifdef RISCOS    /* I don't know if this is OK or not ?? LT */
  1046.     length = fwrite(buffer+offset,1,length,IoIFP(io));
  1047. #else
  1048.     length = write(fileno(IoIFP(io)), buffer+offset, length);
  1049. #endif
  1050.     }
  1051. #ifdef HAS_SOCKET
  1052.     else if (SP > MARK) {
  1053.     char *sockbuf;
  1054.     STRLEN mlen;
  1055.     sockbuf = SvPVx(*++MARK, mlen);
  1056.     length = sendto(fileno(IoIFP(io)), buffer, blen, length,
  1057.                 (struct sockaddr *)sockbuf, mlen);
  1058.     }
  1059.     else
  1060.     length = send(fileno(IoIFP(io)), buffer, blen, length);
  1061. #else
  1062.     else
  1063.     DIE(no_sock_func, "send");
  1064. #endif
  1065.     if (length < 0)
  1066.     goto say_undef;
  1067.     SP = ORIGMARK;
  1068.     PUSHi(length);
  1069.     RETURN;
  1070.  
  1071.   say_undef:
  1072.     SP = ORIGMARK;
  1073.     RETPUSHUNDEF;
  1074. }
  1075.  
  1076. PP(pp_recv)
  1077. {
  1078.     return pp_sysread(ARGS);
  1079. }
  1080.  
  1081. PP(pp_eof)
  1082. {
  1083.     dSP;
  1084.     GV *gv;
  1085.  
  1086.     if (MAXARG <= 0)
  1087.     gv = last_in_gv;
  1088.     else
  1089.     gv = last_in_gv = (GV*)POPs;
  1090.     PUSHs(!gv || do_eof(gv) ? &sv_yes : &sv_no);
  1091.     RETURN;
  1092. }
  1093.  
  1094. PP(pp_tell)
  1095. {
  1096.     dSP; dTARGET;
  1097.     GV *gv;
  1098.  
  1099.     if (MAXARG <= 0)
  1100.     gv = last_in_gv;
  1101.     else
  1102.     gv = last_in_gv = (GV*)POPs;
  1103.     PUSHi( do_tell(gv) );
  1104.     RETURN;
  1105. }
  1106.  
  1107. PP(pp_seek)
  1108. {
  1109.     dSP;
  1110.     GV *gv;
  1111.     int whence = POPi;
  1112.     long offset = POPl;
  1113.  
  1114.     gv = last_in_gv = (GV*)POPs;
  1115.     PUSHs( do_seek(gv, offset, whence) ? &sv_yes : &sv_no );
  1116.     RETURN;
  1117. }
  1118.  
  1119. PP(pp_truncate)
  1120. {
  1121.     dSP;
  1122.     Off_t len = (Off_t)POPn;
  1123.     int result = 1;
  1124.     GV *tmpgv;
  1125.  
  1126.     SETERRNO(0,0);
  1127. #if defined(HAS_TRUNCATE) || defined(HAS_CHSIZE)
  1128. #ifdef HAS_TRUNCATE
  1129.     if (op->op_flags & OPf_SPECIAL) {
  1130.     tmpgv = gv_fetchpv(POPp,FALSE, SVt_PVIO);
  1131.     if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)) ||
  1132.       ftruncate(fileno(IoIFP(GvIOn(tmpgv))), len) < 0)
  1133.         result = 0;
  1134.     }
  1135.     else if (truncate(POPp, len) < 0)
  1136.     result = 0;
  1137. #else
  1138.     if (op->op_flags & OPf_SPECIAL) {
  1139.     tmpgv = gv_fetchpv(POPp,FALSE, SVt_PVIO);
  1140.     if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)) ||
  1141.       chsize(fileno(IoIFP(GvIOn(tmpgv))), len) < 0)
  1142.         result = 0;
  1143.     }
  1144.     else {
  1145.     int tmpfd;
  1146.  
  1147.     if ((tmpfd = open(POPp, 0)) < 0)
  1148.         result = 0;
  1149.     else {
  1150.         if (chsize(tmpfd, len) < 0)
  1151.         result = 0;
  1152.         close(tmpfd);
  1153.     }
  1154.     }
  1155. #endif
  1156.  
  1157.     if (result)
  1158.     RETPUSHYES;
  1159.     if (!errno)
  1160.     SETERRNO(EBADF,RMS$_IFI);
  1161.     RETPUSHUNDEF;
  1162. #else
  1163.     DIE("truncate not implemented");
  1164. #endif
  1165. }
  1166.  
  1167. PP(pp_fcntl)
  1168. {
  1169.     return pp_ioctl(ARGS);
  1170. }
  1171.  
  1172. PP(pp_ioctl)
  1173. {
  1174.     dSP; dTARGET;
  1175.     SV *argsv = POPs;
  1176.     unsigned int func = U_I(POPn);
  1177.     int optype = op->op_type;
  1178.     char *s;
  1179.     int retval;
  1180.     GV *gv = (GV*)POPs;
  1181.     IO *io = GvIOn(gv);
  1182.  
  1183.     if (!io || !argsv || !IoIFP(io)) {
  1184.     SETERRNO(EBADF,RMS$_IFI);    /* well, sort of... */
  1185.     RETPUSHUNDEF;
  1186.     }
  1187.  
  1188.     if (SvPOK(argsv) || !SvNIOK(argsv)) {
  1189.     STRLEN len;
  1190.     s = SvPV_force(argsv, len);
  1191.     retval = IOCPARM_LEN(func);
  1192.     if (len < retval) {
  1193.         s = Sv_Grow(argsv, retval+1);
  1194.         SvCUR_set(argsv, retval);
  1195.     }
  1196.  
  1197.     s[SvCUR(argsv)] = 17;    /* a little sanity check here */
  1198.     }
  1199.     else {
  1200.     retval = SvIV(argsv);
  1201. #ifdef DOSISH
  1202.     s = (char*)(long)retval;    /* ouch */
  1203. #else
  1204.     s = (char*)retval;        /* ouch */
  1205. #endif
  1206.     }
  1207.  
  1208.     TAINT_PROPER(optype == OP_IOCTL ? "ioctl" : "fcntl");
  1209.  
  1210.     if (optype == OP_IOCTL)
  1211. #ifdef HAS_IOCTL
  1212.     retval = ioctl(fileno(IoIFP(io)), func, s);
  1213. #else
  1214.     DIE("ioctl is not implemented");
  1215. #endif
  1216.     else
  1217. #ifdef DOSISH
  1218.     DIE("fcntl is not implemented");
  1219. #else
  1220. #   ifdef HAS_FCNTL
  1221.     retval = fcntl(fileno(IoIFP(io)), func, (int)s);
  1222. #   else
  1223.     DIE("fcntl is not implemented");
  1224. #   endif
  1225. #endif
  1226.  
  1227.     if (SvPOK(argsv)) {
  1228.     if (s[SvCUR(argsv)] != 17)
  1229.         DIE("Possible memory corruption: %s overflowed 3rd argument",
  1230.         op_name[optype]);
  1231.     s[SvCUR(argsv)] = 0;        /* put our null back */
  1232.     SvSETMAGIC(argsv);        /* Assume it has changed */
  1233.     }
  1234.  
  1235.     if (retval == -1)
  1236.     RETPUSHUNDEF;
  1237.     if (retval != 0) {
  1238.     PUSHi(retval);
  1239.     }
  1240.     else {
  1241.     PUSHp("0 but true", 10);
  1242.     }
  1243.     RETURN;
  1244. }
  1245.  
  1246. PP(pp_flock)
  1247. {
  1248.     dSP; dTARGET;
  1249.     I32 value;
  1250.     int argtype;
  1251.     GV *gv;
  1252.     FILE *fp;
  1253. #ifdef HAS_FLOCK
  1254.     argtype = POPi;
  1255.     if (MAXARG <= 0)
  1256.     gv = last_in_gv;
  1257.     else
  1258.     gv = (GV*)POPs;
  1259.     if (gv && GvIO(gv))
  1260.     fp = IoIFP(GvIOp(gv));
  1261.     else
  1262.     fp = Nullfp;
  1263.     if (fp) {
  1264.     value = (I32)(flock(fileno(fp), argtype) >= 0);
  1265.     }
  1266.     else
  1267.     value = 0;
  1268.     PUSHi(value);
  1269.     RETURN;
  1270. #else
  1271. # ifdef HAS_LOCKF
  1272.     DIE(no_func, "flock()"); /* XXX emulate flock() with lockf()? */
  1273. # else
  1274.     DIE(no_func, "flock()");
  1275. # endif
  1276. #endif
  1277. }
  1278.  
  1279. /* Sockets. */
  1280.  
  1281. PP(pp_socket)
  1282. {
  1283.     dSP;
  1284. #ifdef HAS_SOCKET
  1285.     GV *gv;
  1286.     register IO *io;
  1287.     int protocol = POPi;
  1288.     int type = POPi;
  1289.     int domain = POPi;
  1290.     int fd;
  1291.  
  1292.     gv = (GV*)POPs;
  1293.  
  1294.     if (!gv) {
  1295.     SETERRNO(EBADF,LIB$_INVARG);
  1296.     RETPUSHUNDEF;
  1297.     }
  1298.  
  1299.     io = GvIOn(gv);
  1300.     if (IoIFP(io))
  1301.     do_close(gv, FALSE);
  1302.  
  1303.     TAINT_PROPER("socket");
  1304.     fd = socket(domain, type, protocol);
  1305.     if (fd < 0)
  1306.     RETPUSHUNDEF;
  1307.     IoIFP(io) = fdopen(fd, "r");    /* stdio gets confused about sockets */
  1308.     IoOFP(io) = fdopen(fd, "w");
  1309.     IoTYPE(io) = 's';
  1310.  
  1311.     if (!IoIFP(io) || !IoOFP(io)) {
  1312.     if (IoIFP(io)) fclose(IoIFP(io));
  1313.     if (IoOFP(io)) fclose(IoOFP(io));
  1314.     if (!IoIFP(io) && !IoOFP(io))
  1315. #ifndef RISCOS
  1316.         close(fd);
  1317. #else
  1318.         DIE("Call socketshutdown here");
  1319. #endif
  1320.  
  1321.     RETPUSHUNDEF;
  1322.     }
  1323.  
  1324.     RETPUSHYES;
  1325. #else
  1326.     DIE(no_sock_func, "socket");
  1327. #endif
  1328. }
  1329.  
  1330. PP(pp_sockpair)
  1331. {
  1332.     dSP;
  1333. #ifdef HAS_SOCKETPAIR
  1334.     GV *gv1;
  1335.     GV *gv2;
  1336.     register IO *io1;
  1337.     register IO *io2;
  1338.     int protocol = POPi;
  1339.     int type = POPi;
  1340.     int domain = POPi;
  1341.     int fd[2];
  1342.  
  1343.     gv2 = (GV*)POPs;
  1344.     gv1 = (GV*)POPs;
  1345.     if (!gv1 || !gv2)
  1346.     RETPUSHUNDEF;
  1347.  
  1348.     io1 = GvIOn(gv1);
  1349.     io2 = GvIOn(gv2);
  1350.     if (IoIFP(io1))
  1351.     do_close(gv1, FALSE);
  1352.     if (IoIFP(io2))
  1353.     do_close(gv2, FALSE);
  1354.  
  1355.     TAINT_PROPER("socketpair");
  1356.     if (socketpair(domain, type, protocol, fd) < 0)
  1357.     RETPUSHUNDEF;
  1358.     IoIFP(io1) = fdopen(fd[0], "r");
  1359.     IoOFP(io1) = fdopen(fd[0], "w");
  1360.     IoTYPE(io1) = 's';
  1361.     IoIFP(io2) = fdopen(fd[1], "r");
  1362.     IoOFP(io2) = fdopen(fd[1], "w");
  1363.     IoTYPE(io2) = 's';
  1364.     if (!IoIFP(io1) || !IoOFP(io1) || !IoIFP(io2) || !IoOFP(io2)) {
  1365.     if (IoIFP(io1)) fclose(IoIFP(io1));
  1366.     if (IoOFP(io1)) fclose(IoOFP(io1));
  1367.     if (!IoIFP(io1) && !IoOFP(io1)) close(fd[0]);
  1368.     if (IoIFP(io2)) fclose(IoIFP(io2));
  1369.     if (IoOFP(io2)) fclose(IoOFP(io2));
  1370.     if (!IoIFP(io2) && !IoOFP(io2)) close(fd[1]);
  1371.     RETPUSHUNDEF;
  1372.     }
  1373.  
  1374.     RETPUSHYES;
  1375. #else
  1376.     DIE(no_sock_func, "socketpair");
  1377. #endif
  1378. }
  1379.  
  1380. PP(pp_bind)
  1381. {
  1382.     dSP;
  1383. #ifdef HAS_SOCKET
  1384.     SV *addrsv = POPs;
  1385.     char *addr;
  1386.     GV *gv = (GV*)POPs;
  1387.     register IO *io = GvIOn(gv);
  1388.     STRLEN len;
  1389.  
  1390.     if (!io || !IoIFP(io))
  1391.     goto nuts;
  1392.  
  1393.     addr = SvPV(addrsv, len);
  1394.     TAINT_PROPER("bind");
  1395.     if (bind(fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0)
  1396.     RETPUSHYES;
  1397.     else
  1398.     RETPUSHUNDEF;
  1399.  
  1400. nuts:
  1401.     if (dowarn)
  1402.     warn("bind() on closed fd");
  1403.     SETERRNO(EBADF,SS$_IVCHAN);
  1404.     RETPUSHUNDEF;
  1405. #else
  1406.     DIE(no_sock_func, "bind");
  1407. #endif
  1408. }
  1409.  
  1410. PP(pp_connect)
  1411. {
  1412.     dSP;
  1413. #ifdef HAS_SOCKET
  1414.     SV *addrsv = POPs;
  1415.     char *addr;
  1416.     GV *gv = (GV*)POPs;
  1417.     register IO *io = GvIOn(gv);
  1418.     STRLEN len;
  1419.  
  1420.     if (!io || !IoIFP(io))
  1421.     goto nuts;
  1422.  
  1423.     addr = SvPV(addrsv, len);
  1424.     TAINT_PROPER("connect");
  1425.     if (connect(fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0)
  1426.     RETPUSHYES;
  1427.     else
  1428.     RETPUSHUNDEF;
  1429.  
  1430. nuts:
  1431.     if (dowarn)
  1432.     warn("connect() on closed fd");
  1433.     SETERRNO(EBADF,SS$_IVCHAN);
  1434.     RETPUSHUNDEF;
  1435. #else
  1436.     DIE(no_sock_func, "connect");
  1437. #endif
  1438. }
  1439.  
  1440. PP(pp_listen)
  1441. {
  1442.     dSP;
  1443. #ifdef HAS_SOCKET
  1444.     int backlog = POPi;
  1445.     GV *gv = (GV*)POPs;
  1446.     register IO *io = GvIOn(gv);
  1447.  
  1448.     if (!io || !IoIFP(io))
  1449.     goto nuts;
  1450.  
  1451.     if (listen(fileno(IoIFP(io)), backlog) >= 0)
  1452.     RETPUSHYES;
  1453.     else
  1454.     RETPUSHUNDEF;
  1455.  
  1456. nuts:
  1457.     if (dowarn)
  1458.     warn("listen() on closed fd");
  1459.     SETERRNO(EBADF,SS$_IVCHAN);
  1460.     RETPUSHUNDEF;
  1461. #else
  1462.     DIE(no_sock_func, "listen");
  1463. #endif
  1464. }
  1465.  
  1466. PP(pp_accept)
  1467. {
  1468.     dSP; dTARGET;
  1469. #ifdef HAS_SOCKET
  1470.     struct sockaddr_in saddr;    /* use a struct to avoid alignment problems */
  1471.     GV *ngv;
  1472.     GV *ggv;
  1473.     register IO *nstio;
  1474.     register IO *gstio;
  1475.     int len = sizeof saddr;
  1476.     int fd;
  1477.  
  1478.     ggv = (GV*)POPs;
  1479.     ngv = (GV*)POPs;
  1480.  
  1481.     if (!ngv)
  1482.     goto badexit;
  1483.     if (!ggv)
  1484.     goto nuts;
  1485.  
  1486.     gstio = GvIO(ggv);
  1487.     if (!gstio || !IoIFP(gstio))
  1488.     goto nuts;
  1489.  
  1490.     nstio = GvIOn(ngv);
  1491.     if (IoIFP(nstio))
  1492.     do_close(ngv, FALSE);
  1493.  
  1494.     fd = accept(fileno(IoIFP(gstio)), (struct sockaddr *)&saddr, &len);
  1495.     if (fd < 0)
  1496.     goto badexit;
  1497.     IoIFP(nstio) = fdopen(fd, "r");
  1498.     IoOFP(nstio) = fdopen(fd, "w");
  1499.     IoTYPE(nstio) = 's';
  1500.     if (!IoIFP(nstio) || !IoOFP(nstio)) {
  1501.     if (IoIFP(nstio)) fclose(IoIFP(nstio));
  1502.     if (IoOFP(nstio)) fclose(IoOFP(nstio));
  1503.     if (!IoIFP(nstio) && !IoOFP(nstio)) close(fd);
  1504.     goto badexit;
  1505.     }
  1506.  
  1507.     PUSHp((char *)&saddr, len);
  1508.     RETURN;
  1509.  
  1510. nuts:
  1511.     if (dowarn)
  1512.     warn("accept() on closed fd");
  1513.     SETERRNO(EBADF,SS$_IVCHAN);
  1514.  
  1515. badexit:
  1516.     RETPUSHUNDEF;
  1517.  
  1518. #else
  1519.     DIE(no_sock_func, "accept");
  1520. #endif
  1521. }
  1522.  
  1523. PP(pp_shutdown)
  1524. {
  1525.     dSP; dTARGET;
  1526. #ifdef HAS_SOCKET
  1527.     int how = POPi;
  1528.     GV *gv = (GV*)POPs;
  1529.     register IO *io = GvIOn(gv);
  1530.  
  1531.     if (!io || !IoIFP(io))
  1532.     goto nuts;
  1533.  
  1534.     PUSHi( shutdown(fileno(IoIFP(io)), how) >= 0 );
  1535.     RETURN;
  1536.  
  1537. nuts:
  1538.     if (dowarn)
  1539.     warn("shutdown() on closed fd");
  1540.     SETERRNO(EBADF,SS$_IVCHAN);
  1541.     RETPUSHUNDEF;
  1542. #else
  1543.     DIE(no_sock_func, "shutdown");
  1544. #endif
  1545. }
  1546.  
  1547. PP(pp_gsockopt)
  1548. {
  1549. #ifdef HAS_SOCKET
  1550.     return pp_ssockopt(ARGS);
  1551. #else
  1552.     DIE(no_sock_func, "getsockopt");
  1553. #endif
  1554. }
  1555.  
  1556. PP(pp_ssockopt)
  1557. {
  1558.     dSP;
  1559. #ifdef HAS_SOCKET
  1560.     int optype = op->op_type;
  1561.     SV *sv;
  1562.     int fd;
  1563.     unsigned int optname;
  1564.     unsigned int lvl;
  1565.     GV *gv;
  1566.     register IO *io;
  1567.     int aint;
  1568.  
  1569.     if (optype == OP_GSOCKOPT)
  1570.     sv = sv_2mortal(NEWSV(22, 257));
  1571.     else
  1572.     sv = POPs;
  1573.     optname = (unsigned int) POPi;
  1574.     lvl = (unsigned int) POPi;
  1575.  
  1576.     gv = (GV*)POPs;
  1577.     io = GvIOn(gv);
  1578.     if (!io || !IoIFP(io))
  1579.     goto nuts;
  1580.  
  1581.     fd = fileno(IoIFP(io));
  1582.     switch (optype) {
  1583.     case OP_GSOCKOPT:
  1584.     SvGROW(sv, 257);
  1585.     (void)SvPOK_only(sv);
  1586.     SvCUR_set(sv,256);
  1587.     *SvEND(sv) ='\0';
  1588.     aint = SvCUR(sv);
  1589.     if (getsockopt(fd, lvl, optname, SvPVX(sv), &aint) < 0)
  1590.         goto nuts2;
  1591.     SvCUR_set(sv,aint);
  1592.     *SvEND(sv) ='\0';
  1593.     PUSHs(sv);
  1594.     break;
  1595.     case OP_SSOCKOPT: {
  1596.         STRLEN len = 0;
  1597.         char *buf = 0;
  1598.         if (SvPOKp(sv))
  1599.         buf = SvPV(sv, len);
  1600.         else if (SvOK(sv)) {
  1601.         aint = (int)SvIV(sv);
  1602.         buf = (char*)&aint;
  1603.         len = sizeof(int);
  1604.         }
  1605.         if (setsockopt(fd, lvl, optname, buf, (int)len) < 0)
  1606.         goto nuts2;
  1607.         PUSHs(&sv_yes);
  1608.     }
  1609.     break;
  1610.     }
  1611.     RETURN;
  1612.  
  1613. nuts:
  1614.     if (dowarn)
  1615.     warn("[gs]etsockopt() on closed fd");
  1616.     SETERRNO(EBADF,SS$_IVCHAN);
  1617. nuts2:
  1618.     RETPUSHUNDEF;
  1619.  
  1620. #else
  1621.     DIE(no_sock_func, "setsockopt");
  1622. #endif
  1623. }
  1624.  
  1625. PP(pp_getsockname)
  1626. {
  1627. #ifdef HAS_SOCKET
  1628.     return pp_getpeername(ARGS);
  1629. #else
  1630.     DIE(no_sock_func, "getsockname");
  1631. #endif
  1632. }
  1633.  
  1634. PP(pp_getpeername)
  1635. {
  1636.     dSP;
  1637. #ifdef HAS_SOCKET
  1638.     int optype = op->op_type;
  1639.     SV *sv;
  1640.     int fd;
  1641.     GV *gv = (GV*)POPs;
  1642.     register IO *io = GvIOn(gv);
  1643.     int aint;
  1644.  
  1645.     if (!io || !IoIFP(io))
  1646.     goto nuts;
  1647.  
  1648.     sv = sv_2mortal(NEWSV(22, 257));
  1649.     (void)SvPOK_only(sv);
  1650.     SvCUR_set(sv,256);
  1651.     *SvEND(sv) ='\0';
  1652.     aint = SvCUR(sv);
  1653.     fd = fileno(IoIFP(io));
  1654.     switch (optype) {
  1655.     case OP_GETSOCKNAME:
  1656.     if (getsockname(fd, (struct sockaddr *)SvPVX(sv), &aint) < 0)
  1657.         goto nuts2;
  1658.     break;
  1659.     case OP_GETPEERNAME:
  1660.     if (getpeername(fd, (struct sockaddr *)SvPVX(sv), &aint) < 0)
  1661.         goto nuts2;
  1662.     break;
  1663.     }
  1664.     SvCUR_set(sv,aint);
  1665.     *SvEND(sv) ='\0';
  1666.     PUSHs(sv);
  1667.     RETURN;
  1668.  
  1669. nuts:
  1670.     if (dowarn)
  1671.     warn("get{sock, peer}name() on closed fd");
  1672.     SETERRNO(EBADF,SS$_IVCHAN);
  1673. nuts2:
  1674.     RETPUSHUNDEF;
  1675.  
  1676. #else
  1677.     DIE(no_sock_func, "getpeername");
  1678. #endif
  1679. }
  1680.  
  1681. /* Stat calls. */
  1682.  
  1683. PP(pp_lstat)
  1684. {
  1685.     return pp_stat(ARGS);
  1686. }
  1687.  
  1688. PP(pp_stat)
  1689. {
  1690.     dSP;
  1691.     GV *tmpgv;
  1692.     I32 max = 13;
  1693.  
  1694.     if (op->op_flags & OPf_REF) {
  1695.     tmpgv = cGVOP->op_gv;
  1696.       do_fstat:
  1697.     if (tmpgv != defgv) {
  1698.         laststype = OP_STAT;
  1699.         statgv = tmpgv;
  1700.         sv_setpv(statname, "");
  1701.         if (!GvIO(tmpgv) || !IoIFP(GvIOp(tmpgv)) ||
  1702.           Fstat(fileno(IoIFP(GvIOn(tmpgv))), &statcache) < 0) {
  1703.         max = 0;
  1704.         laststatval = -1;
  1705.         }
  1706.     }
  1707.     else if (laststatval < 0)
  1708.         max = 0;
  1709.     }
  1710.     else {
  1711.     SV* sv = POPs;
  1712.     if (SvTYPE(sv) == SVt_PVGV) {
  1713.         tmpgv = (GV*)sv;
  1714.         goto do_fstat;
  1715.     }
  1716.     else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVGV) {
  1717.         tmpgv = (GV*)SvRV(sv);
  1718.         goto do_fstat;
  1719.     }
  1720.     sv_setpv(statname, SvPV(sv,na));
  1721.     statgv = Nullgv;
  1722. #ifdef HAS_LSTAT
  1723.     laststype = op->op_type;
  1724.     if (op->op_type == OP_LSTAT)
  1725.         laststatval = lstat(SvPV(statname, na), &statcache);
  1726.     else
  1727. #endif
  1728.         laststatval = Stat(SvPV(statname, na), &statcache);
  1729.     if (laststatval < 0) {
  1730.         if (dowarn && strchr(SvPV(statname, na), '\n'))
  1731.         warn(warn_nl, "stat");
  1732.         max = 0;
  1733.     }
  1734.     }
  1735.  
  1736.     EXTEND(SP, 13);
  1737.     if (GIMME != G_ARRAY) {
  1738.     if (max)
  1739.         RETPUSHYES;
  1740.     else
  1741.         RETPUSHUNDEF;
  1742.     }
  1743.     if (max) {
  1744. #ifdef RISCOS
  1745.     PUSHs(sv_2mortal(newSViv((I32)0)));
  1746.     PUSHs(sv_2mortal(newSViv((I32)0)));
  1747.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_mode)));
  1748.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_nlink)));
  1749.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_uid)));
  1750.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_gid)));
  1751.     PUSHs(sv_2mortal(newSViv((I32)0)));
  1752.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_size)));
  1753.     PUSHs(sv_2mortal(newSViv((I32)0)));
  1754.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_mtime)));
  1755.     PUSHs(sv_2mortal(newSViv((I32)0)));
  1756. #else
  1757.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_dev)));
  1758.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_ino)));
  1759.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_mode)));
  1760.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_nlink)));
  1761.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_uid)));
  1762.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_gid)));
  1763.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_rdev)));
  1764.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_size)));
  1765.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_atime)));
  1766.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_mtime)));
  1767.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_ctime)));
  1768. #endif
  1769.  
  1770. #ifdef USE_STAT_BLOCKS
  1771.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_blksize)));
  1772.     PUSHs(sv_2mortal(newSViv((I32)statcache.st_blocks)));
  1773. #else
  1774.     PUSHs(sv_2mortal(newSVpv("", 0)));
  1775.     PUSHs(sv_2mortal(newSVpv("", 0)));
  1776. #endif
  1777.     }
  1778.     RETURN;
  1779. }
  1780.  
  1781. PP(pp_ftrread)
  1782. {
  1783.     I32 result = my_stat(ARGS);
  1784.     dSP;
  1785.     if (result < 0)
  1786.     RETPUSHUNDEF;
  1787.     if (cando(S_IRUSR, 0, &statcache))
  1788.     RETPUSHYES;
  1789.     RETPUSHNO;
  1790. }
  1791.  
  1792. PP(pp_ftrwrite)
  1793. {
  1794.     I32 result = my_stat(ARGS);
  1795.     dSP;
  1796.     if (result < 0)
  1797.     RETPUSHUNDEF;
  1798.     if (cando(S_IWUSR, 0, &statcache))
  1799.     RETPUSHYES;
  1800.     RETPUSHNO;
  1801. }
  1802.  
  1803. PP(pp_ftrexec)
  1804. {
  1805.     I32 result = my_stat(ARGS);
  1806.     dSP;
  1807.     if (result < 0)
  1808.     RETPUSHUNDEF;
  1809.     if (cando(S_IXUSR, 0, &statcache))
  1810.     RETPUSHYES;
  1811.     RETPUSHNO;
  1812. }
  1813.  
  1814. PP(pp_fteread)
  1815. {
  1816.     I32 result = my_stat(ARGS);
  1817.     dSP;
  1818.     if (result < 0)
  1819.     RETPUSHUNDEF;
  1820.     if (cando(S_IRUSR, 1, &statcache))
  1821.     RETPUSHYES;
  1822.     RETPUSHNO;
  1823. }
  1824.  
  1825. PP(pp_ftewrite)
  1826. {
  1827.     I32 result = my_stat(ARGS);
  1828.     dSP;
  1829.     if (result < 0)
  1830.     RETPUSHUNDEF;
  1831.     if (cando(S_IWUSR, 1, &statcache))
  1832.     RETPUSHYES;
  1833.     RETPUSHNO;
  1834. }
  1835.  
  1836. PP(pp_fteexec)
  1837. {
  1838.     I32 result = my_stat(ARGS);
  1839.     dSP;
  1840.     if (result < 0)
  1841.     RETPUSHUNDEF;
  1842.     if (cando(S_IXUSR, 1, &statcache))
  1843.     RETPUSHYES;
  1844.     RETPUSHNO;
  1845. }
  1846.  
  1847. PP(pp_ftis)
  1848. {
  1849.     I32 result = my_stat(ARGS);
  1850.     dSP;
  1851.     if (result < 0)
  1852.     RETPUSHUNDEF;
  1853.     RETPUSHYES;
  1854. }
  1855.  
  1856. PP(pp_fteowned)
  1857. {
  1858.     return pp_ftrowned(ARGS);
  1859. }
  1860.  
  1861. PP(pp_ftrowned)
  1862. {
  1863.     I32 result = my_stat(ARGS);
  1864.     dSP;
  1865.     if (result < 0)
  1866.     RETPUSHUNDEF;
  1867.     if (statcache.st_uid == (op->op_type == OP_FTEOWNED ? euid : uid) )
  1868.     RETPUSHYES;
  1869.     RETPUSHNO;
  1870. }
  1871.  
  1872. PP(pp_ftzero)
  1873. {
  1874.     I32 result = my_stat(ARGS);
  1875.     dSP;
  1876.     if (result < 0)
  1877.     RETPUSHUNDEF;
  1878.     if (!statcache.st_size)
  1879.     RETPUSHYES;
  1880.     RETPUSHNO;
  1881. }
  1882.  
  1883. PP(pp_ftsize)
  1884. {
  1885.     I32 result = my_stat(ARGS);
  1886.     dSP; dTARGET;
  1887.     if (result < 0)
  1888.     RETPUSHUNDEF;
  1889.     PUSHi(statcache.st_size);
  1890.     RETURN;
  1891. }
  1892.  
  1893. PP(pp_ftmtime)
  1894. {
  1895.     I32 result = my_stat(ARGS);
  1896.     dSP; dTARGET;
  1897.     if (result < 0)
  1898.     RETPUSHUNDEF;
  1899.     PUSHn( (basetime - statcache.st_mtime) / 86400.0 );
  1900.     RETURN;
  1901. }
  1902.  
  1903. PP(pp_ftatime)
  1904. {
  1905.  
  1906.     I32 result = my_stat(ARGS);
  1907.     dSP; dTARGET;
  1908. #ifdef RISCOS
  1909.     RETPUSHUNDEF;
  1910. #else
  1911.     if (result < 0)
  1912.     RETPUSHUNDEF;
  1913.     PUSHn( (basetime - statcache.st_atime) / 86400.0 );
  1914.     RETURN;
  1915. #endif
  1916. }
  1917.  
  1918. PP(pp_ftctime)
  1919. {
  1920.     I32 result = my_stat(ARGS);
  1921.     dSP; dTARGET;
  1922. #ifdef RISCOS
  1923.     RETPUSHUNDEF;
  1924. #else
  1925.     if (result < 0)
  1926.     RETPUSHUNDEF;
  1927.     PUSHn( (basetime - statcache.st_ctime) / 86400.0 );
  1928.     RETURN;
  1929. #endif
  1930. }
  1931.  
  1932. PP(pp_ftsock)
  1933. {
  1934.     I32 result = my_stat(ARGS);
  1935.     dSP;
  1936.     if (result < 0)
  1937.     RETPUSHUNDEF;
  1938.     if (S_ISSOCK(statcache.st_mode))
  1939.     RETPUSHYES;
  1940.     RETPUSHNO;
  1941. }
  1942.  
  1943. PP(pp_ftchr)
  1944. {
  1945.     I32 result = my_stat(ARGS);
  1946.     dSP;
  1947.     if (result < 0)
  1948.     RETPUSHUNDEF;
  1949.     if (S_ISCHR(statcache.st_mode))
  1950.     RETPUSHYES;
  1951.     RETPUSHNO;
  1952. }
  1953.  
  1954. PP(pp_ftblk)
  1955. {
  1956.     I32 result = my_stat(ARGS);
  1957.     dSP;
  1958.     if (result < 0)
  1959.     RETPUSHUNDEF;
  1960.     if (S_ISBLK(statcache.st_mode))
  1961.     RETPUSHYES;
  1962.     RETPUSHNO;
  1963. }
  1964.  
  1965. PP(pp_ftfile)
  1966. {
  1967.     I32 result = my_stat(ARGS);
  1968.     dSP;
  1969.     if (result < 0)
  1970.     RETPUSHUNDEF;
  1971.     if (S_ISREG(statcache.st_mode))
  1972.     RETPUSHYES;
  1973.     RETPUSHNO;
  1974. }
  1975.  
  1976. PP(pp_ftdir)
  1977. {
  1978.     I32 result = my_stat(ARGS);
  1979.     dSP;
  1980.     if (result < 0)
  1981.     RETPUSHUNDEF;
  1982.     if (S_ISDIR(statcache.st_mode))
  1983.     RETPUSHYES;
  1984.     RETPUSHNO;
  1985. }
  1986.  
  1987. PP(pp_ftpipe)
  1988. {
  1989.     I32 result = my_stat(ARGS);
  1990.     dSP;
  1991.     if (result < 0)
  1992.     RETPUSHUNDEF;
  1993.     if (S_ISFIFO(statcache.st_mode))
  1994.     RETPUSHYES;
  1995.     RETPUSHNO;
  1996. }
  1997.  
  1998. PP(pp_ftlink)
  1999. {
  2000.     I32 result = my_lstat(ARGS);
  2001.     dSP;
  2002.     if (result < 0)
  2003.     RETPUSHUNDEF;
  2004.     if (S_ISLNK(statcache.st_mode))
  2005.     RETPUSHYES;
  2006.     RETPUSHNO;
  2007. }
  2008.  
  2009. PP(pp_ftsuid)
  2010. {
  2011.     dSP;
  2012. #ifdef S_ISUID
  2013.     I32 result = my_stat(ARGS);
  2014.     SPAGAIN;
  2015.     if (result < 0)
  2016.     RETPUSHUNDEF;
  2017.     if (statcache.st_mode & S_ISUID)
  2018.     RETPUSHYES;
  2019. #endif
  2020.     RETPUSHNO;
  2021. }
  2022.  
  2023. PP(pp_ftsgid)
  2024. {
  2025.     dSP;
  2026. #ifdef S_ISGID
  2027.     I32 result = my_stat(ARGS);
  2028.     SPAGAIN;
  2029.     if (result < 0)
  2030.     RETPUSHUNDEF;
  2031.     if (statcache.st_mode & S_ISGID)
  2032.     RETPUSHYES;
  2033. #endif
  2034.     RETPUSHNO;
  2035. }
  2036.  
  2037. PP(pp_ftsvtx)
  2038. {
  2039.     dSP;
  2040. #ifdef S_ISVTX
  2041.     I32 result = my_stat(ARGS);
  2042.     SPAGAIN;
  2043.     if (result < 0)
  2044.     RETPUSHUNDEF;
  2045.     if (statcache.st_mode & S_ISVTX)
  2046.     RETPUSHYES;
  2047. #endif
  2048.     RETPUSHNO;
  2049. }
  2050.  
  2051. PP(pp_fttty)
  2052. {
  2053.     dSP;
  2054.     int fd;
  2055.     GV *gv;
  2056.     char *tmps;
  2057.     if (op->op_flags & OPf_REF) {
  2058.     gv = cGVOP->op_gv;
  2059.     tmps = "";
  2060.     }
  2061.     else
  2062.     gv = gv_fetchpv(tmps = POPp, FALSE, SVt_PVIO);
  2063.     if (GvIO(gv) && IoIFP(GvIOp(gv)))
  2064.     fd = fileno(IoIFP(GvIOp(gv)));
  2065.     else if (isDIGIT(*tmps))
  2066.     fd = atoi(tmps);
  2067.     else
  2068.     RETPUSHUNDEF;
  2069.     if (isatty(fd))
  2070.     RETPUSHYES;
  2071.     RETPUSHNO;
  2072. }
  2073.  
  2074. #if defined(USE_STD_STDIO) || defined(atarist) /* this will work with atariST */
  2075. # define FBASE(f) ((f)->_base)
  2076. # define FSIZE(f) ((f)->_cnt + ((f)->_ptr - (f)->_base))
  2077. # define FPTR(f) ((f)->_ptr)
  2078. # define FCOUNT(f) ((f)->_cnt)
  2079. #else
  2080. # if defined(USE_LINUX_STDIO)
  2081. #   define FBASE(f) ((f)->_IO_read_base)
  2082. #   define FSIZE(f) ((f)->_IO_read_end - FBASE(f))
  2083. #   define FPTR(f) ((f)->_IO_read_ptr)
  2084. #   define FCOUNT(f) ((f)->_IO_read_end - FPTR(f))
  2085. # endif
  2086. #endif
  2087.  
  2088. PP(pp_fttext)
  2089. {
  2090.     dSP;
  2091.     I32 i;
  2092.     I32 len;
  2093.     I32 odd = 0;
  2094.     STDCHAR tbuf[512];
  2095.     register STDCHAR *s;
  2096.     register IO *io;
  2097.     SV *sv;
  2098.  
  2099.     if (op->op_flags & OPf_REF) {
  2100.     EXTEND(SP, 1);
  2101.     if (cGVOP->op_gv == defgv) {
  2102.         if (statgv)
  2103.         io = GvIO(statgv);
  2104.         else {
  2105.         sv = statname;
  2106.         goto really_filename;
  2107.         }
  2108.     }
  2109.     else {
  2110.         statgv = cGVOP->op_gv;
  2111.         sv_setpv(statname, "");
  2112.         io = GvIO(statgv);
  2113.     }
  2114.     if (io && IoIFP(io)) {
  2115. #ifdef FBASE
  2116.         Fstat(fileno(IoIFP(io)), &statcache);
  2117.         if (S_ISDIR(statcache.st_mode))    /* handle NFS glitch */
  2118.         if (op->op_type == OP_FTTEXT)
  2119.             RETPUSHNO;
  2120.         else
  2121.             RETPUSHYES;
  2122.         if (FCOUNT(IoIFP(io)) <= 0) {
  2123.         i = getc(IoIFP(io));
  2124.         if (i != EOF)
  2125.             (void)ungetc(i, IoIFP(io));
  2126.         }
  2127.         if (FCOUNT(IoIFP(io)) <= 0)    /* null file is anything */
  2128.         RETPUSHYES;
  2129.         len = FSIZE(IoIFP(io));
  2130.         s = FBASE(IoIFP(io));
  2131. #else
  2132.         DIE("-T and -B not implemented on filehandles");
  2133. #endif
  2134.     }
  2135.     else {
  2136.         if (dowarn)
  2137.         warn("Test on unopened file <%s>",
  2138.           GvENAME(cGVOP->op_gv));
  2139.         SETERRNO(EBADF,RMS$_IFI);
  2140.         RETPUSHUNDEF;
  2141.     }
  2142.     }
  2143.     else {
  2144.     sv = POPs;
  2145.     statgv = Nullgv;
  2146.     sv_setpv(statname, SvPV(sv, na));
  2147.       really_filename:
  2148. #ifdef RISCOS
  2149.         RETPUSHUNDEF;
  2150. #else
  2151. #ifdef HAS_OPEN3
  2152.     i = open(SvPV(sv, na), O_RDONLY, 0);
  2153. #else
  2154.     i = open(SvPV(sv, na), 0);
  2155. #endif
  2156.     if (i < 0) {
  2157.         if (dowarn && strchr(SvPV(sv, na), '\n'))
  2158.         warn(warn_nl, "open");
  2159.         RETPUSHUNDEF;
  2160.     }
  2161.     Fstat(i, &statcache);
  2162.     len = read(i, tbuf, 512);
  2163.     (void)close(i);
  2164.     if (len <= 0) {
  2165.         if (S_ISDIR(statcache.st_mode) && op->op_type == OP_FTTEXT)
  2166.         RETPUSHNO;        /* special case NFS directories */
  2167.         RETPUSHYES;        /* null file is anything */
  2168.     }
  2169.     s = tbuf;
  2170. #endif/* RISCOS */
  2171.     }
  2172.  
  2173.     /* now scan s to look for textiness */
  2174.  
  2175.     for (i = 0; i < len; i++, s++) {
  2176.     if (!*s) {            /* null never allowed in text */
  2177.         odd += len;
  2178.         break;
  2179.     }
  2180.     else if (*s & 128)
  2181.         odd++;
  2182.     else if (*s < 32 &&
  2183.       *s != '\n' && *s != '\r' && *s != '\b' &&
  2184.       *s != '\t' && *s != '\f' && *s != 27)
  2185.         odd++;
  2186.     }
  2187.  
  2188.     if ((odd * 30 > len) == (op->op_type == OP_FTTEXT)) /* allow 30% odd */
  2189.     RETPUSHNO;
  2190.     else
  2191.     RETPUSHYES;
  2192. }
  2193.  
  2194. PP(pp_ftbinary)
  2195. {
  2196.     return pp_fttext(ARGS);
  2197. }
  2198.  
  2199. /* File calls. */
  2200.  
  2201. PP(pp_chdir)
  2202. {
  2203.     dSP; dTARGET;
  2204.     char *tmps;
  2205.     SV **svp;
  2206.  
  2207.     if (MAXARG < 1)
  2208.     tmps = Nullch;
  2209.     else
  2210.     tmps = POPp;
  2211.     if (!tmps || !*tmps) {
  2212.     svp = hv_fetch(GvHVn(envgv), "HOME", 4, FALSE);
  2213.     if (svp)
  2214.         tmps = SvPV(*svp, na);
  2215.     }
  2216.     if (!tmps || !*tmps) {
  2217.     svp = hv_fetch(GvHVn(envgv), "LOGDIR", 6, FALSE);
  2218.     if (svp)
  2219.         tmps = SvPV(*svp, na);
  2220.     }
  2221.     TAINT_PROPER("chdir");
  2222.     PUSHi( chdir(tmps) >= 0 );
  2223. #ifdef VMS
  2224.     /* Clear the DEFAULT element of ENV so we'll get the new value
  2225.      * in the future. */
  2226.     hv_delete(GvHVn(envgv),"DEFAULT",7);
  2227. #endif
  2228.     RETURN;
  2229. }
  2230.  
  2231. PP(pp_chown)
  2232. {
  2233.     dSP; dMARK; dTARGET;
  2234.     I32 value;
  2235. #ifdef HAS_CHOWN
  2236.     value = (I32)apply(op->op_type, MARK, SP);
  2237.     SP = MARK;
  2238.     PUSHi(value);
  2239.     RETURN;
  2240. #else
  2241.     DIE(no_func, "Unsupported function chown");
  2242. #endif
  2243. }
  2244.  
  2245. PP(pp_chroot)
  2246. {
  2247.     dSP; dTARGET;
  2248.     char *tmps;
  2249. #ifdef HAS_CHROOT
  2250.     tmps = POPp;
  2251.     TAINT_PROPER("chroot");
  2252.     PUSHi( chroot(tmps) >= 0 );
  2253.     RETURN;
  2254. #else
  2255.     DIE(no_func, "chroot");
  2256. #endif
  2257. }
  2258.  
  2259. PP(pp_unlink)
  2260. {
  2261.     dSP; dMARK; dTARGET;
  2262.     I32 value;
  2263.     value = (I32)apply(op->op_type, MARK, SP);
  2264.     SP = MARK;
  2265.     PUSHi(value);
  2266.     RETURN;
  2267. }
  2268.  
  2269. PP(pp_chmod)
  2270. {
  2271.     dSP; dMARK; dTARGET;
  2272.     I32 value;
  2273.     value = (I32)apply(op->op_type, MARK, SP);
  2274.     SP = MARK;
  2275.     PUSHi(value);
  2276.     RETURN;
  2277. }
  2278.  
  2279. PP(pp_utime)
  2280. {
  2281.     dSP; dMARK; dTARGET;
  2282.     I32 value;
  2283.     value = (I32)apply(op->op_type, MARK, SP);
  2284.     SP = MARK;
  2285.     PUSHi(value);
  2286.     RETURN;
  2287. }
  2288.  
  2289. PP(pp_rename)
  2290. {
  2291.     dSP; dTARGET;
  2292.     int anum;
  2293.  
  2294.     char *tmps2 = POPp;
  2295.     char *tmps = SvPV(TOPs, na);
  2296.     TAINT_PROPER("rename");
  2297. #ifdef HAS_RENAME
  2298.     anum = rename(tmps, tmps2);
  2299. #else
  2300.     if (same_dirent(tmps2, tmps))    /* can always rename to same name */
  2301.     anum = 1;
  2302.     else {
  2303.     if (euid || Stat(tmps2, &statbuf) < 0 || !S_ISDIR(statbuf.st_mode))
  2304.         (void)UNLINK(tmps2);
  2305.     if (!(anum = link(tmps, tmps2)))
  2306.         anum = UNLINK(tmps);
  2307.     }
  2308. #endif
  2309.     SETi( anum >= 0 );
  2310.     RETURN;
  2311. }
  2312.  
  2313. PP(pp_link)
  2314. {
  2315.     dSP; dTARGET;
  2316. #ifdef HAS_LINK
  2317.     char *tmps2 = POPp;
  2318.     char *tmps = SvPV(TOPs, na);
  2319.     TAINT_PROPER("link");
  2320.     SETi( link(tmps, tmps2) >= 0 );
  2321. #else
  2322.     DIE(no_func, "Unsupported function link");
  2323. #endif
  2324.     RETURN;
  2325. }
  2326.  
  2327. PP(pp_symlink)
  2328. {
  2329.     dSP; dTARGET;
  2330. #ifdef HAS_SYMLINK
  2331.     char *tmps2 = POPp;
  2332.     char *tmps = SvPV(TOPs, na);
  2333.     TAINT_PROPER("symlink");
  2334.     SETi( symlink(tmps, tmps2) >= 0 );
  2335.     RETURN;
  2336. #else
  2337.     DIE(no_func, "symlink");
  2338. #endif
  2339. }
  2340.  
  2341. PP(pp_readlink)
  2342. {
  2343.     dSP; dTARGET;
  2344. #ifdef HAS_SYMLINK
  2345.     char *tmps;
  2346.     int len;
  2347.     tmps = POPp;
  2348.     len = readlink(tmps, buf, sizeof buf);
  2349.     EXTEND(SP, 1);
  2350.     if (len < 0)
  2351.     RETPUSHUNDEF;
  2352.     PUSHp(buf, len);
  2353.     RETURN;
  2354. #else
  2355.     EXTEND(SP, 1);
  2356.     RETSETUNDEF;        /* just pretend it's a normal file */
  2357. #endif
  2358. }
  2359.  
  2360. #if !defined(HAS_MKDIR) || !defined(HAS_RMDIR)
  2361. static int
  2362. dooneliner(cmd, filename)
  2363. char *cmd;
  2364. char *filename;
  2365. {
  2366.     char mybuf[8192];
  2367.     char *s, *tmps;
  2368.     int anum = 1;
  2369.     FILE *myfp;
  2370.  
  2371.     strcpy(mybuf, cmd);
  2372.     strcat(mybuf, " ");
  2373.     for (s = mybuf+strlen(mybuf); *filename; ) {
  2374.     *s++ = '\\';
  2375.     *s++ = *filename++;
  2376.     }
  2377.     strcpy(s, " 2>&1");
  2378.     myfp = my_popen(mybuf, "r");
  2379.     if (myfp) {
  2380.     *mybuf = '\0';
  2381.     s = fgets(mybuf, sizeof mybuf, myfp);
  2382.     my_pclose(myfp);
  2383.     if (s != Nullch) {
  2384.         for (errno = 1; errno < sys_nerr; errno++) {
  2385. #ifdef HAS_SYS_ERRLIST
  2386.         if (instr(mybuf, sys_errlist[errno]))    /* you don't see this */
  2387.             return 0;
  2388. #else
  2389.         char *errmsg;                /* especially if it isn't there */
  2390.  
  2391.         if (instr(mybuf,
  2392.                   (errmsg = strerror(errno)) ? errmsg : "NoErRoR"))
  2393.             return 0;
  2394. #endif
  2395.         }
  2396.         SETERRNO(0,0);
  2397. #ifndef EACCES
  2398. #define EACCES EPERM
  2399. #endif
  2400.         if (instr(mybuf, "cannot make"))
  2401.         SETERRNO(EEXIST,RMS$_FEX);
  2402.         else if (instr(mybuf, "existing file"))
  2403.         SETERRNO(EEXIST,RMS$_FEX);
  2404.         else if (instr(mybuf, "ile exists"))
  2405.         SETERRNO(EEXIST,RMS$_FEX);
  2406.         else if (instr(mybuf, "non-exist"))
  2407.         SETERRNO(ENOENT,RMS$_FNF);
  2408.         else if (instr(mybuf, "does not exist"))
  2409.         SETERRNO(ENOENT,RMS$_FNF);
  2410.         else if (instr(mybuf, "not empty"))
  2411.         SETERRNO(EBUSY,SS$_DEVOFFLINE);
  2412.         else if (instr(mybuf, "cannot access"))
  2413.         SETERRNO(EACCES,RMS$_PRV);
  2414.         else
  2415.         SETERRNO(EPERM,RMS$_PRV);
  2416.         return 0;
  2417.     }
  2418.     else {    /* some mkdirs return no failure indication */
  2419.         anum = (Stat(filename, &statbuf) >= 0);
  2420.         if (op->op_type == OP_RMDIR)
  2421.         anum = !anum;
  2422.         if (anum)
  2423.         SETERRNO(0,0);
  2424.         else
  2425.         SETERRNO(EACCES,RMS$_PRV);    /* a guess */
  2426.     }
  2427.     return anum;
  2428.     }
  2429.     else
  2430.     return 0;
  2431. }
  2432. #endif
  2433.  
  2434. PP(pp_mkdir)
  2435. {
  2436.     dSP; dTARGET;
  2437.     int mode = POPi;
  2438. #ifndef HAS_MKDIR
  2439.     int oldumask;
  2440. #endif
  2441.     char *tmps = SvPV(TOPs, na);
  2442.  
  2443.     TAINT_PROPER("mkdir");
  2444. #ifdef HAS_MKDIR
  2445. #ifdef RISCOS
  2446.     SETi( mkdir(tmps) >= 0 );
  2447. #else
  2448.     SETi( mkdir(tmps, mode) >= 0 );
  2449. #endif
  2450. #else
  2451.     SETi( dooneliner("mkdir", tmps) );
  2452.     oldumask = umask(0);
  2453.     umask(oldumask);
  2454.     chmod(tmps, (mode & ~oldumask) & 0777);
  2455. #endif
  2456.     RETURN;
  2457. }
  2458.  
  2459. PP(pp_rmdir)
  2460. {
  2461.     dSP; dTARGET;
  2462.     char *tmps;
  2463.  
  2464.     tmps = POPp;
  2465.     TAINT_PROPER("rmdir");
  2466. #ifdef HAS_RMDIR
  2467.     XPUSHi( rmdir(tmps) >= 0 );
  2468. #else
  2469.     XPUSHi( dooneliner("rmdir", tmps) );
  2470. #endif
  2471.     RETURN;
  2472. }
  2473.  
  2474. /* Directory calls. */
  2475.  
  2476. PP(pp_open_dir)
  2477. {
  2478.     dSP;
  2479. #if defined(Direntry_t) && defined(HAS_READDIR)
  2480.     char *dirname = POPp;
  2481.     GV *gv = (GV*)POPs;
  2482.     register IO *io = GvIOn(gv);
  2483.  
  2484.     if (!io)
  2485.     goto nope;
  2486.  
  2487.     if (IoDIRP(io))
  2488.     closedir(IoDIRP(io));
  2489.     if (!(IoDIRP(io) = opendir(dirname)))
  2490.     goto nope;
  2491.  
  2492.     RETPUSHYES;
  2493. nope:
  2494.     if (!errno)
  2495.     SETERRNO(EBADF,RMS$_DIR);
  2496.     RETPUSHUNDEF;
  2497. #else
  2498.     DIE(no_dir_func, "opendir");
  2499. #endif
  2500. }
  2501.  
  2502. PP(pp_readdir)
  2503. {
  2504.     dSP;
  2505. #if defined(Direntry_t) && defined(HAS_READDIR)
  2506. #ifndef I_DIRENT
  2507.     Direntry_t *readdir _((DIR *));
  2508. #endif
  2509.     register Direntry_t *dp;
  2510.     GV *gv = (GV*)POPs;
  2511.     register IO *io = GvIOn(gv);
  2512.  
  2513.     if (!io || !IoDIRP(io))
  2514.     goto nope;
  2515.  
  2516.     if (GIMME == G_ARRAY) {
  2517.     /*SUPPRESS 560*/
  2518.     while (dp = (Direntry_t *)readdir(IoDIRP(io))) {
  2519. #ifdef DIRNAMLEN
  2520.         XPUSHs(sv_2mortal(newSVpv(dp->d_name, dp->d_namlen)));
  2521. #else
  2522.         XPUSHs(sv_2mortal(newSVpv(dp->d_name, 0)));
  2523. #endif
  2524.     }
  2525.     }
  2526.     else {
  2527.     if (!(dp = (Direntry_t *)readdir(IoDIRP(io))))
  2528.         goto nope;
  2529. #ifdef DIRNAMLEN
  2530.     XPUSHs(sv_2mortal(newSVpv(dp->d_name, dp->d_namlen)));
  2531. #else
  2532.     XPUSHs(sv_2mortal(newSVpv(dp->d_name, 0)));
  2533. #endif
  2534.     }
  2535.     RETURN;
  2536.  
  2537. nope:
  2538.     if (!errno)
  2539.     SETERRNO(EBADF,RMS$_ISI);
  2540.     if (GIMME == G_ARRAY)
  2541.     RETURN;
  2542.     else
  2543.     RETPUSHUNDEF;
  2544. #else
  2545.     DIE(no_dir_func, "readdir");
  2546. #endif
  2547. }
  2548.  
  2549. PP(pp_telldir)
  2550. {
  2551.     dSP; dTARGET;
  2552. #if defined(HAS_TELLDIR) || defined(telldir)
  2553. #if !defined(telldir) && !defined(HAS_TELLDIR_PROTOTYPE)
  2554.     long telldir _((DIR *));
  2555. #endif
  2556.     GV *gv = (GV*)POPs;
  2557.     register IO *io = GvIOn(gv);
  2558.  
  2559.     if (!io || !IoDIRP(io))
  2560.     goto nope;
  2561.  
  2562.     PUSHi( telldir(IoDIRP(io)) );
  2563.     RETURN;
  2564. nope:
  2565.     if (!errno)
  2566.     SETERRNO(EBADF,RMS$_ISI);
  2567.     RETPUSHUNDEF;
  2568. #else
  2569.     DIE(no_dir_func, "telldir");
  2570. #endif
  2571. }
  2572.  
  2573. PP(pp_seekdir)
  2574. {
  2575.     dSP;
  2576. #if defined(HAS_SEEKDIR) || defined(seekdir)
  2577.     long along = POPl;
  2578.     GV *gv = (GV*)POPs;
  2579.     register IO *io = GvIOn(gv);
  2580.  
  2581.     if (!io || !IoDIRP(io))
  2582.     goto nope;
  2583.  
  2584.     (void)seekdir(IoDIRP(io), along);
  2585.  
  2586.     RETPUSHYES;
  2587. nope:
  2588.     if (!errno)
  2589.     SETERRNO(EBADF,RMS$_ISI);
  2590.     RETPUSHUNDEF;
  2591. #else
  2592.     DIE(no_dir_func, "seekdir");
  2593. #endif
  2594. }
  2595.  
  2596. PP(pp_rewinddir)
  2597. {
  2598.     dSP;
  2599. #if defined(HAS_REWINDDIR) || defined(rewinddir)
  2600.     GV *gv = (GV*)POPs;
  2601.     register IO *io = GvIOn(gv);
  2602.  
  2603.     if (!io || !IoDIRP(io))
  2604.     goto nope;
  2605.  
  2606.     (void)rewinddir(IoDIRP(io));
  2607.     RETPUSHYES;
  2608. nope:
  2609.     if (!errno)
  2610.     SETERRNO(EBADF,RMS$_ISI);
  2611.     RETPUSHUNDEF;
  2612. #else
  2613.     DIE(no_dir_func, "rewinddir");
  2614. #endif
  2615. }
  2616.  
  2617. PP(pp_closedir)
  2618. {
  2619.     dSP;
  2620. #if defined(Direntry_t) && defined(HAS_READDIR)
  2621.     GV *gv = (GV*)POPs;
  2622.     register IO *io = GvIOn(gv);
  2623.  
  2624.     if (!io || !IoDIRP(io))
  2625.     goto nope;
  2626.  
  2627. #ifdef VOID_CLOSEDIR
  2628.     closedir(IoDIRP(io));
  2629. #else
  2630.     if (closedir(IoDIRP(io)) < 0) {
  2631.     IoDIRP(io) = 0; /* Don't try to close again--coredumps on SysV */
  2632.     goto nope;
  2633.     }
  2634. #endif
  2635.     IoDIRP(io) = 0;
  2636.  
  2637.     RETPUSHYES;
  2638. nope:
  2639.     if (!errno)
  2640.     SETERRNO(EBADF,RMS$_IFI);
  2641.     RETPUSHUNDEF;
  2642. #else
  2643.     DIE(no_dir_func, "closedir");
  2644. #endif
  2645. }
  2646.  
  2647. /* Process control. */
  2648.  
  2649. PP(pp_fork)
  2650. {
  2651.     dSP; dTARGET;
  2652.     int childpid;
  2653.     GV *tmpgv;
  2654.  
  2655.     EXTEND(SP, 1);
  2656. #ifdef HAS_FORK
  2657.     childpid = fork();
  2658.     if (childpid < 0)
  2659.     RETSETUNDEF;
  2660.     if (!childpid) {
  2661.     /*SUPPRESS 560*/
  2662.     if (tmpgv = gv_fetchpv("$", TRUE, SVt_PV))
  2663.         sv_setiv(GvSV(tmpgv), (I32)getpid());
  2664.     hv_clear(pidstatus);    /* no kids, so don't wait for 'em */
  2665.     }
  2666.     PUSHi(childpid);
  2667.     RETURN;
  2668. #else
  2669.     DIE(no_func, "Unsupported function fork");
  2670. #endif
  2671. }
  2672.  
  2673. PP(pp_wait)
  2674. {
  2675.     dSP; dTARGET;
  2676.     int childpid;
  2677.     int argflags;
  2678.     I32 value;
  2679.  
  2680.     EXTEND(SP, 1);
  2681. #ifdef HAS_WAIT
  2682.     childpid = wait(&argflags);
  2683.     if (childpid > 0)
  2684.     pidgone(childpid, argflags);
  2685.     value = (I32)childpid;
  2686.     statusvalue = FIXSTATUS(argflags);
  2687.     PUSHi(value);
  2688.     RETURN;
  2689. #else
  2690.     DIE(no_func, "Unsupported function wait");
  2691. #endif
  2692. }
  2693.  
  2694. PP(pp_waitpid)
  2695. {
  2696.     dSP; dTARGET;
  2697.     int childpid;
  2698.     int optype;
  2699.     int argflags;
  2700.     I32 value;
  2701.  
  2702. #ifdef HAS_WAIT
  2703.     optype = POPi;
  2704.     childpid = TOPi;
  2705.     childpid = wait4pid(childpid, &argflags, optype);
  2706.     value = (I32)childpid;
  2707.     statusvalue = FIXSTATUS(argflags);
  2708.     SETi(value);
  2709.     RETURN;
  2710. #else
  2711.     DIE(no_func, "Unsupported function wait");
  2712. #endif
  2713. }
  2714.  
  2715. PP(pp_system)
  2716. {
  2717.     dSP; dMARK; dORIGMARK; dTARGET;
  2718.     I32 value;
  2719.     int childpid;
  2720.     int result;
  2721.     int status;
  2722.     Signal_t (*ihand)();     /* place to save signal during system() */
  2723.     Signal_t (*qhand)();     /* place to save signal during system() */
  2724.  
  2725. #if defined(HAS_FORK) && !defined(VMS)
  2726.     if (SP - MARK == 1) {
  2727.     if (tainting) {
  2728.         char *junk = SvPV(TOPs, na);
  2729.         TAINT_ENV();
  2730.         TAINT_PROPER("system");
  2731.     }
  2732.     }
  2733.     while ((childpid = vfork()) == -1) {
  2734.     if (errno != EAGAIN) {
  2735.         value = -1;
  2736.         SP = ORIGMARK;
  2737.         PUSHi(value);
  2738.         RETURN;
  2739.     }
  2740.     sleep(5);
  2741.     }
  2742.     if (childpid > 0) {
  2743.     ihand = signal(SIGINT, SIG_IGN);
  2744.     qhand = signal(SIGQUIT, SIG_IGN);
  2745.     do {
  2746.         result = wait4pid(childpid, &status, 0);
  2747.     } while (result == -1 && errno == EINTR);
  2748.     (void)signal(SIGINT, ihand);
  2749.     (void)signal(SIGQUIT, qhand);
  2750.     statusvalue = FIXSTATUS(status);
  2751.     if (result < 0)
  2752.         value = -1;
  2753.     else {
  2754.         value = (I32)((unsigned int)status & 0xffff);
  2755.     }
  2756.     do_execfree();    /* free any memory child malloced on vfork */
  2757.     SP = ORIGMARK;
  2758.     PUSHi(value);
  2759.     RETURN;
  2760.     }
  2761.     if (op->op_flags & OPf_STACKED) {
  2762.     SV *really = *++MARK;
  2763.     value = (I32)do_aexec(really, MARK, SP);
  2764.     }
  2765.     else if (SP - MARK != 1)
  2766.     value = (I32)do_aexec(Nullsv, MARK, SP);
  2767.     else {
  2768.     value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), na));
  2769.     }
  2770.     _exit(-1);
  2771. #else /* ! FORK or VMS */
  2772.     if (op->op_flags & OPf_STACKED) {
  2773.     SV *really = *++MARK;
  2774.     value = (I32)do_aspawn(really, MARK, SP);
  2775.     }
  2776.     else if (SP - MARK != 1)
  2777.     value = (I32)do_aspawn(Nullsv, MARK, SP);
  2778.     else {
  2779.     value = (I32)do_spawn(SvPVx(sv_mortalcopy(*SP), na));
  2780.     }
  2781.     do_execfree();
  2782.     SP = ORIGMARK;
  2783.     PUSHi(value);
  2784. #endif /* !FORK or VMS */
  2785.     RETURN;
  2786. }
  2787.  
  2788. PP(pp_exec)
  2789. {
  2790.     dSP; dMARK; dORIGMARK; dTARGET;
  2791.     I32 value;
  2792.  
  2793.     if (op->op_flags & OPf_STACKED) {
  2794.     SV *really = *++MARK;
  2795.     value = (I32)do_aexec(really, MARK, SP);
  2796.     }
  2797.     else if (SP - MARK != 1)
  2798. #ifdef VMS
  2799.     value = (I32)vms_do_aexec(Nullsv, MARK, SP);
  2800. #else
  2801.     value = (I32)do_aexec(Nullsv, MARK, SP);
  2802. #endif
  2803.     else {
  2804.     if (tainting) {
  2805.         char *junk = SvPV(*SP, na);
  2806.         TAINT_ENV();
  2807.         TAINT_PROPER("exec");
  2808.     }
  2809. #ifdef VMS
  2810.     value = (I32)vms_do_exec(SvPVx(sv_mortalcopy(*SP), na));
  2811. #else
  2812.     value = (I32)do_exec(SvPVx(sv_mortalcopy(*SP), na));
  2813. #endif
  2814.     }
  2815.     SP = ORIGMARK;
  2816.     PUSHi(value);
  2817.     RETURN;
  2818. }
  2819.  
  2820. PP(pp_kill)
  2821. {
  2822.     dSP; dMARK; dTARGET;
  2823.     I32 value;
  2824. #ifdef HAS_KILL
  2825.     value = (I32)apply(op->op_type, MARK, SP);
  2826.     SP = MARK;
  2827.     PUSHi(value);
  2828.     RETURN;
  2829. #else
  2830.     DIE(no_func, "Unsupported function kill");
  2831. #endif
  2832. }
  2833.  
  2834. PP(pp_getppid)
  2835. {
  2836. #ifdef HAS_GETPPID
  2837.     dSP; dTARGET;
  2838.     XPUSHi( getppid() );
  2839.     RETURN;
  2840. #else
  2841.     DIE(no_func, "getppid");
  2842. #endif
  2843. }
  2844.  
  2845. PP(pp_getpgrp)
  2846. {
  2847. #ifdef HAS_GETPGRP
  2848.     dSP; dTARGET;
  2849.     int pid;
  2850.     I32 value;
  2851.  
  2852.     if (MAXARG < 1)
  2853.     pid = 0;
  2854.     else
  2855.     pid = SvIVx(POPs);
  2856. #ifdef USE_BSDPGRP
  2857.     value = (I32)getpgrp(pid);
  2858. #else
  2859.     if (pid != 0)
  2860.     DIE("POSIX getpgrp can't take an argument");
  2861.     value = (I32)getpgrp();
  2862. #endif
  2863.     XPUSHi(value);
  2864.     RETURN;
  2865. #else
  2866.     DIE(no_func, "getpgrp()");
  2867. #endif
  2868. }
  2869.  
  2870. PP(pp_setpgrp)
  2871. {
  2872. #ifdef HAS_SETPGRP
  2873.     dSP; dTARGET;
  2874.     int pgrp;
  2875.     int pid;
  2876.     if (MAXARG < 2) {
  2877.     pgrp = 0;
  2878.     pid = 0;
  2879.     }
  2880.     else {
  2881.     pgrp = POPi;
  2882.     pid = TOPi;
  2883.     }
  2884.  
  2885.     TAINT_PROPER("setpgrp");
  2886. #ifdef USE_BSDPGRP
  2887.     SETi( setpgrp(pid, pgrp) >= 0 );
  2888. #else
  2889.     if ((pgrp != 0) || (pid != 0)) {
  2890.     DIE("POSIX setpgrp can't take an argument");
  2891.     }
  2892.     SETi( setpgrp() >= 0 );
  2893. #endif /* USE_BSDPGRP */
  2894.     RETURN;
  2895. #else
  2896.     DIE(no_func, "setpgrp()");
  2897. #endif
  2898. }
  2899.  
  2900. PP(pp_getpriority)
  2901. {
  2902.     dSP; dTARGET;
  2903.     int which;
  2904.     int who;
  2905. #ifdef HAS_GETPRIORITY
  2906.     who = POPi;
  2907.     which = TOPi;
  2908.     SETi( getpriority(which, who) );
  2909.     RETURN;
  2910. #else
  2911.     DIE(no_func, "getpriority()");
  2912. #endif
  2913. }
  2914.  
  2915. PP(pp_setpriority)
  2916. {
  2917.     dSP; dTARGET;
  2918.     int which;
  2919.     int who;
  2920.     int niceval;
  2921. #ifdef HAS_SETPRIORITY
  2922.     niceval = POPi;
  2923.     who = POPi;
  2924.     which = TOPi;
  2925.     TAINT_PROPER("setpriority");
  2926.     SETi( setpriority(which, who, niceval) >= 0 );
  2927.     RETURN;
  2928. #else
  2929.     DIE(no_func, "setpriority()");
  2930. #endif
  2931. }
  2932.  
  2933. /* Time calls. */
  2934.  
  2935. PP(pp_time)
  2936. {
  2937.     dSP; dTARGET;
  2938.     XPUSHi( time(Null(Time_t*)) );
  2939.     RETURN;
  2940. }
  2941.  
  2942. #ifndef HZ
  2943. #define HZ 60
  2944. #endif
  2945.  
  2946. PP(pp_tms)
  2947. {
  2948.     dSP;
  2949.  
  2950. #if defined(MSDOS) || !defined(HAS_TIMES)
  2951.     DIE("times not implemented");
  2952. #else
  2953.     EXTEND(SP, 4);
  2954.  
  2955. #ifndef VMS
  2956.     (void)times(×buf);
  2957. #else
  2958.     (void)times((tbuffer_t *)×buf);  /* time.h uses different name for */
  2959.                                           /* struct tms, though same data   */
  2960.                                           /* is returned.                   */
  2961. #endif
  2962.  
  2963.     PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_utime)/HZ)));
  2964.     if (GIMME == G_ARRAY) {
  2965.     PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_stime)/HZ)));
  2966.     PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_cutime)/HZ)));
  2967.     PUSHs(sv_2mortal(newSVnv(((double)timesbuf.tms_cstime)/HZ)));
  2968.     }
  2969.     RETURN;
  2970. #endif /* MSDOS */
  2971. }
  2972.  
  2973. PP(pp_localtime)
  2974. {
  2975.     return pp_gmtime(ARGS);
  2976. }
  2977.  
  2978. PP(pp_gmtime)
  2979. {
  2980.     dSP;
  2981.     Time_t when;
  2982.     struct tm *tmbuf;
  2983.     static char *dayname[] = {"Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"};
  2984.     static char *monname[] = {"Jan", "Feb", "Mar", "Apr", "May", "Jun",
  2985.                   "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"};
  2986.  
  2987.     if (MAXARG < 1)
  2988.     (void)time(&when);
  2989.     else
  2990.     when = (Time_t)SvIVx(POPs);
  2991.  
  2992.     if (op->op_type == OP_LOCALTIME)
  2993.     tmbuf = localtime(&when);
  2994.     else
  2995.     tmbuf = gmtime(&when);
  2996.  
  2997.     EXTEND(SP, 9);
  2998.     if (GIMME != G_ARRAY) {
  2999.     dTARGET;
  3000.     char mybuf[30];
  3001.     if (!tmbuf)
  3002.         RETPUSHUNDEF;
  3003.     sprintf(mybuf, "%s %s %2d %02d:%02d:%02d %d",
  3004.         dayname[tmbuf->tm_wday],
  3005.         monname[tmbuf->tm_mon],
  3006.         tmbuf->tm_mday,
  3007.         tmbuf->tm_hour,
  3008.         tmbuf->tm_min,
  3009.         tmbuf->tm_sec,
  3010.         tmbuf->tm_year + 1900);
  3011.     PUSHp(mybuf, strlen(mybuf));
  3012.     }
  3013.     else if (tmbuf) {
  3014.     PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_sec)));
  3015.     PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_min)));
  3016.     PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_hour)));
  3017.     PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_mday)));
  3018.     PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_mon)));
  3019.     PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_year)));
  3020.     PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_wday)));
  3021.     PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_yday)));
  3022.     PUSHs(sv_2mortal(newSViv((I32)tmbuf->tm_isdst)));
  3023.     }
  3024.     RETURN;
  3025. }
  3026.  
  3027. PP(pp_alarm)
  3028. {
  3029.     dSP; dTARGET;
  3030.     int anum;
  3031. #ifdef HAS_ALARM
  3032.     anum = POPi;
  3033.     anum = alarm((unsigned int)anum);
  3034.     EXTEND(SP, 1);
  3035.     if (anum < 0)
  3036.     RETPUSHUNDEF;
  3037.     PUSHi((I32)anum);
  3038.     RETURN;
  3039. #else
  3040.     DIE(no_func, "Unsupported function alarm");
  3041. #endif
  3042. }
  3043.  
  3044. PP(pp_sleep)
  3045. {
  3046.     dSP; dTARGET;
  3047.     I32 duration;
  3048.     Time_t lasttime;
  3049.     Time_t when;
  3050.  
  3051.     (void)time(&lasttime);
  3052. #ifdef RISCOS
  3053.     duration = POPi;
  3054.     sleep((unsigned int)duration);
  3055. #else
  3056.     if (MAXARG < 1)
  3057.     pause();
  3058.     else {
  3059.     duration = POPi;
  3060.     sleep((unsigned int)duration);
  3061.     }
  3062. #endif
  3063.     (void)time(&when);
  3064.     XPUSHi(when - lasttime);
  3065.     RETURN;
  3066. }
  3067.  
  3068. /* Shared memory. */
  3069.  
  3070. PP(pp_shmget)
  3071. {
  3072.     return pp_semget(ARGS);
  3073. }
  3074.  
  3075. PP(pp_shmctl)
  3076. {
  3077.     return pp_semctl(ARGS);
  3078. }
  3079.  
  3080. PP(pp_shmread)
  3081. {
  3082.     return pp_shmwrite(ARGS);
  3083. }
  3084.  
  3085. PP(pp_shmwrite)
  3086. {
  3087. #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
  3088.     dSP; dMARK; dTARGET;
  3089.     I32 value = (I32)(do_shmio(op->op_type, MARK, SP) >= 0);
  3090.     SP = MARK;
  3091.     PUSHi(value);
  3092.     RETURN;
  3093. #else
  3094.     return pp_semget(ARGS);
  3095. #endif
  3096. }
  3097.  
  3098. /* Message passing. */
  3099.  
  3100. PP(pp_msgget)
  3101. {
  3102.     return pp_semget(ARGS);
  3103. }
  3104.  
  3105. PP(pp_msgctl)
  3106. {
  3107.     return pp_semctl(ARGS);
  3108. }
  3109.  
  3110. PP(pp_msgsnd)
  3111. {
  3112. #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
  3113.     dSP; dMARK; dTARGET;
  3114.     I32 value = (I32)(do_msgsnd(MARK, SP) >= 0);
  3115.     SP = MARK;
  3116.     PUSHi(value);
  3117.     RETURN;
  3118. #else
  3119.     return pp_semget(ARGS);
  3120. #endif
  3121. }
  3122.  
  3123. PP(pp_msgrcv)
  3124. {
  3125. #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
  3126.     dSP; dMARK; dTARGET;
  3127.     I32 value = (I32)(do_msgrcv(MARK, SP) >= 0);
  3128.     SP = MARK;
  3129.     PUSHi(value);
  3130.     RETURN;
  3131. #else
  3132.     return pp_semget(ARGS);
  3133. #endif
  3134. }
  3135.  
  3136. /* Semaphores. */
  3137.  
  3138. PP(pp_semget)
  3139. {
  3140. #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
  3141.     dSP; dMARK; dTARGET;
  3142.     int anum = do_ipcget(op->op_type, MARK, SP);
  3143.     SP = MARK;
  3144.     if (anum == -1)
  3145.     RETPUSHUNDEF;
  3146.     PUSHi(anum);
  3147.     RETURN;
  3148. #else
  3149.     DIE("System V IPC is not implemented on this machine");
  3150. #endif
  3151. }
  3152.  
  3153. PP(pp_semctl)
  3154. {
  3155. #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
  3156.     dSP; dMARK; dTARGET;
  3157.     int anum = do_ipcctl(op->op_type, MARK, SP);
  3158.     SP = MARK;
  3159.     if (anum == -1)
  3160.     RETSETUNDEF;
  3161.     if (anum != 0) {
  3162.     PUSHi(anum);
  3163.     }
  3164.     else {
  3165.     PUSHp("0 but true",10);
  3166.     }
  3167.     RETURN;
  3168. #else
  3169.     return pp_semget(ARGS);
  3170. #endif
  3171. }
  3172.  
  3173. PP(pp_semop)
  3174. {
  3175. #if defined(HAS_MSG) || defined(HAS_SEM) || defined(HAS_SHM)
  3176.     dSP; dMARK; dTARGET;
  3177.     I32 value = (I32)(do_semop(MARK, SP) >= 0);
  3178.     SP = MARK;
  3179.     PUSHi(value);
  3180.     RETURN;
  3181. #else
  3182.     return pp_semget(ARGS);
  3183. #endif
  3184. }
  3185.  
  3186. /* Get system info. */
  3187.  
  3188. PP(pp_ghbyname)
  3189. {
  3190. #ifdef HAS_SOCKET
  3191.     return pp_ghostent(ARGS);
  3192. #else
  3193.     DIE(no_sock_func, "gethostbyname");
  3194. #endif
  3195. }
  3196.  
  3197. PP(pp_ghbyaddr)
  3198. {
  3199. #ifdef HAS_SOCKET
  3200.     return pp_ghostent(ARGS);
  3201. #else
  3202.     DIE(no_sock_func, "gethostbyaddr");
  3203. #endif
  3204. }
  3205.  
  3206. PP(pp_ghostent)
  3207. {
  3208.     dSP;
  3209. #ifdef HAS_SOCKET
  3210.     I32 which = op->op_type;
  3211.     register char **elem;
  3212.     register SV *sv;
  3213.     struct hostent *gethostbyname();
  3214.     struct hostent *gethostbyaddr();
  3215. #ifdef HAS_GETHOSTENT
  3216.     struct hostent *gethostent();
  3217. #endif
  3218.     struct hostent *hent;
  3219.     unsigned long len;
  3220.  
  3221.     EXTEND(SP, 10);
  3222.     if (which == OP_GHBYNAME) {
  3223.     hent = gethostbyname(POPp);
  3224.     }
  3225.     else if (which == OP_GHBYADDR) {
  3226.     int addrtype = POPi;
  3227.     SV *addrsv = POPs;
  3228.     STRLEN addrlen;
  3229.     char *addr = SvPV(addrsv, addrlen);
  3230.  
  3231.     hent = gethostbyaddr(addr, addrlen, addrtype);
  3232.     }
  3233.     else
  3234. #ifdef HAS_GETHOSTENT
  3235.     hent = gethostent();
  3236. #else
  3237.     DIE("gethostent not implemented");
  3238. #endif
  3239.  
  3240. #ifdef HOST_NOT_FOUND
  3241.     if (!hent)
  3242.     statusvalue = FIXSTATUS(h_errno);
  3243. #endif
  3244.  
  3245.     if (GIMME != G_ARRAY) {
  3246.     PUSHs(sv = sv_newmortal());
  3247.     if (hent) {
  3248.         if (which == OP_GHBYNAME) {
  3249.         sv_setpvn(sv, hent->h_addr, hent->h_length);
  3250.         }
  3251.         else
  3252.         sv_setpv(sv, (char*)hent->h_name);
  3253.     }
  3254.     RETURN;
  3255.     }
  3256.  
  3257.     if (hent) {
  3258.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3259.     sv_setpv(sv, (char*)hent->h_name);
  3260.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3261.     for (elem = hent->h_aliases; elem && *elem; elem++) {
  3262.         sv_catpv(sv, *elem);
  3263.         if (elem[1])
  3264.         sv_catpvn(sv, " ", 1);
  3265.     }
  3266.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3267.     sv_setiv(sv, (I32)hent->h_addrtype);
  3268.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3269.     len = hent->h_length;
  3270.     sv_setiv(sv, (I32)len);
  3271. #ifdef h_addr
  3272.     for (elem = hent->h_addr_list; elem && *elem; elem++) {
  3273.         XPUSHs(sv = sv_mortalcopy(&sv_no));
  3274.         sv_setpvn(sv, *elem, len);
  3275.     }
  3276. #else
  3277.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3278.     sv_setpvn(sv, hent->h_addr, len);
  3279. #endif /* h_addr */
  3280.     }
  3281.     RETURN;
  3282. #else
  3283.     DIE(no_sock_func, "gethostent");
  3284. #endif
  3285. }
  3286.  
  3287. PP(pp_gnbyname)
  3288. {
  3289. #ifdef HAS_SOCKET
  3290.     return pp_gnetent(ARGS);
  3291. #else
  3292.     DIE(no_sock_func, "getnetbyname");
  3293. #endif
  3294. }
  3295.  
  3296. PP(pp_gnbyaddr)
  3297. {
  3298. #ifdef HAS_SOCKET
  3299.     return pp_gnetent(ARGS);
  3300. #else
  3301.     DIE(no_sock_func, "getnetbyaddr");
  3302. #endif
  3303. }
  3304.  
  3305. PP(pp_gnetent)
  3306. {
  3307.     dSP;
  3308. #ifdef HAS_SOCKET
  3309.     I32 which = op->op_type;
  3310.     register char **elem;
  3311.     register SV *sv;
  3312.     struct netent *getnetbyname();
  3313.     struct netent *getnetbyaddr();
  3314.     struct netent *getnetent();
  3315.     struct netent *nent;
  3316.  
  3317.     if (which == OP_GNBYNAME)
  3318.     nent = getnetbyname(POPp);
  3319.     else if (which == OP_GNBYADDR) {
  3320.     int addrtype = POPi;
  3321.     unsigned long addr = U_L(POPn);
  3322.     nent = getnetbyaddr((long)addr, addrtype);
  3323.     }
  3324.     else
  3325.     nent = getnetent();
  3326.  
  3327.     EXTEND(SP, 4);
  3328.     if (GIMME != G_ARRAY) {
  3329.     PUSHs(sv = sv_newmortal());
  3330.     if (nent) {
  3331.         if (which == OP_GNBYNAME)
  3332.         sv_setiv(sv, (I32)nent->n_net);
  3333.         else
  3334.         sv_setpv(sv, nent->n_name);
  3335.     }
  3336.     RETURN;
  3337.     }
  3338.  
  3339.     if (nent) {
  3340.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3341.     sv_setpv(sv, nent->n_name);
  3342.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3343.     for (elem = nent->n_aliases; *elem; elem++) {
  3344.         sv_catpv(sv, *elem);
  3345.         if (elem[1])
  3346.         sv_catpvn(sv, " ", 1);
  3347.     }
  3348.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3349.     sv_setiv(sv, (I32)nent->n_addrtype);
  3350.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3351.     sv_setiv(sv, (I32)nent->n_net);
  3352.     }
  3353.  
  3354.     RETURN;
  3355. #else
  3356.     DIE(no_sock_func, "getnetent");
  3357. #endif
  3358. }
  3359.  
  3360. PP(pp_gpbyname)
  3361. {
  3362. #ifdef HAS_SOCKET
  3363.     return pp_gprotoent(ARGS);
  3364. #else
  3365.     DIE(no_sock_func, "getprotobyname");
  3366. #endif
  3367. }
  3368.  
  3369. PP(pp_gpbynumber)
  3370. {
  3371. #ifdef HAS_SOCKET
  3372.     return pp_gprotoent(ARGS);
  3373. #else
  3374.     DIE(no_sock_func, "getprotobynumber");
  3375. #endif
  3376. }
  3377.  
  3378. PP(pp_gprotoent)
  3379. {
  3380.     dSP;
  3381. #ifdef HAS_SOCKET
  3382.     I32 which = op->op_type;
  3383.     register char **elem;
  3384.     register SV *sv;
  3385.     struct protoent *getprotobyname();
  3386.     struct protoent *getprotobynumber();
  3387.     struct protoent *getprotoent();
  3388.     struct protoent *pent;
  3389.  
  3390.     if (which == OP_GPBYNAME)
  3391.     pent = getprotobyname(POPp);
  3392.     else if (which == OP_GPBYNUMBER)
  3393.     pent = getprotobynumber(POPi);
  3394.     else
  3395.     pent = getprotoent();
  3396.  
  3397.     EXTEND(SP, 3);
  3398.     if (GIMME != G_ARRAY) {
  3399.     PUSHs(sv = sv_newmortal());
  3400.     if (pent) {
  3401.         if (which == OP_GPBYNAME)
  3402.         sv_setiv(sv, (I32)pent->p_proto);
  3403.         else
  3404.         sv_setpv(sv, pent->p_name);
  3405.     }
  3406.     RETURN;
  3407.     }
  3408.  
  3409.     if (pent) {
  3410.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3411.     sv_setpv(sv, pent->p_name);
  3412.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3413.     for (elem = pent->p_aliases; *elem; elem++) {
  3414.         sv_catpv(sv, *elem);
  3415.         if (elem[1])
  3416.         sv_catpvn(sv, " ", 1);
  3417.     }
  3418.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3419.     sv_setiv(sv, (I32)pent->p_proto);
  3420.     }
  3421.  
  3422.     RETURN;
  3423. #else
  3424.     DIE(no_sock_func, "getprotoent");
  3425. #endif
  3426. }
  3427.  
  3428. PP(pp_gsbyname)
  3429. {
  3430. #ifdef HAS_SOCKET
  3431.     return pp_gservent(ARGS);
  3432. #else
  3433.     DIE(no_sock_func, "getservbyname");
  3434. #endif
  3435. }
  3436.  
  3437. PP(pp_gsbyport)
  3438. {
  3439. #ifdef HAS_SOCKET
  3440.     return pp_gservent(ARGS);
  3441. #else
  3442.     DIE(no_sock_func, "getservbyport");
  3443. #endif
  3444. }
  3445.  
  3446. PP(pp_gservent)
  3447. {
  3448.     dSP;
  3449. #ifdef HAS_SOCKET
  3450.     I32 which = op->op_type;
  3451.     register char **elem;
  3452.     register SV *sv;
  3453.     struct servent *getservbyname();
  3454.     struct servent *getservbynumber();
  3455.     struct servent *getservent();
  3456.     struct servent *sent;
  3457.  
  3458.     if (which == OP_GSBYNAME) {
  3459.     char *proto = POPp;
  3460.     char *name = POPp;
  3461.  
  3462.     if (proto && !*proto)
  3463.         proto = Nullch;
  3464.  
  3465.     sent = getservbyname(name, proto);
  3466.     }
  3467.     else if (which == OP_GSBYPORT) {
  3468.     char *proto = POPp;
  3469.     int port = POPi;
  3470.  
  3471.     sent = getservbyport(port, proto);
  3472.     }
  3473.     else
  3474.     sent = getservent();
  3475.  
  3476.     EXTEND(SP, 4);
  3477.     if (GIMME != G_ARRAY) {
  3478.     PUSHs(sv = sv_newmortal());
  3479.     if (sent) {
  3480.         if (which == OP_GSBYNAME) {
  3481. #ifdef HAS_NTOHS
  3482.         sv_setiv(sv, (I32)ntohs(sent->s_port));
  3483. #else
  3484.         sv_setiv(sv, (I32)(sent->s_port));
  3485. #endif
  3486.         }
  3487.         else
  3488.         sv_setpv(sv, sent->s_name);
  3489.     }
  3490.     RETURN;
  3491.     }
  3492.  
  3493.     if (sent) {
  3494.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3495.     sv_setpv(sv, sent->s_name);
  3496.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3497.     for (elem = sent->s_aliases; *elem; elem++) {
  3498.         sv_catpv(sv, *elem);
  3499.         if (elem[1])
  3500.         sv_catpvn(sv, " ", 1);
  3501.     }
  3502.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3503. #ifdef HAS_NTOHS
  3504.     sv_setiv(sv, (I32)ntohs(sent->s_port));
  3505. #else
  3506.     sv_setiv(sv, (I32)(sent->s_port));
  3507. #endif
  3508.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3509.     sv_setpv(sv, sent->s_proto);
  3510.     }
  3511.  
  3512.     RETURN;
  3513. #else
  3514.     DIE(no_sock_func, "getservent");
  3515. #endif
  3516. }
  3517.  
  3518. PP(pp_shostent)
  3519. {
  3520.     dSP;
  3521. #ifdef HAS_SOCKET
  3522.     sethostent(TOPi);
  3523.     RETSETYES;
  3524. #else
  3525.     DIE(no_sock_func, "sethostent");
  3526. #endif
  3527. }
  3528.  
  3529. PP(pp_snetent)
  3530. {
  3531.     dSP;
  3532. #ifdef HAS_SOCKET
  3533.     setnetent(TOPi);
  3534.     RETSETYES;
  3535. #else
  3536.     DIE(no_sock_func, "setnetent");
  3537. #endif
  3538. }
  3539.  
  3540. PP(pp_sprotoent)
  3541. {
  3542.     dSP;
  3543. #ifdef HAS_SOCKET
  3544.     setprotoent(TOPi);
  3545.     RETSETYES;
  3546. #else
  3547.     DIE(no_sock_func, "setprotoent");
  3548. #endif
  3549. }
  3550.  
  3551. PP(pp_sservent)
  3552. {
  3553.     dSP;
  3554. #ifdef HAS_SOCKET
  3555.     setservent(TOPi);
  3556.     RETSETYES;
  3557. #else
  3558.     DIE(no_sock_func, "setservent");
  3559. #endif
  3560. }
  3561.  
  3562. PP(pp_ehostent)
  3563. {
  3564.     dSP;
  3565. #ifdef HAS_SOCKET
  3566.     endhostent();
  3567.     EXTEND(sp,1);
  3568.     RETPUSHYES;
  3569. #else
  3570.     DIE(no_sock_func, "endhostent");
  3571. #endif
  3572. }
  3573.  
  3574. PP(pp_enetent)
  3575. {
  3576.     dSP;
  3577. #ifdef HAS_SOCKET
  3578.     endnetent();
  3579.     EXTEND(sp,1);
  3580.     RETPUSHYES;
  3581. #else
  3582.     DIE(no_sock_func, "endnetent");
  3583. #endif
  3584. }
  3585.  
  3586. PP(pp_eprotoent)
  3587. {
  3588.     dSP;
  3589. #ifdef HAS_SOCKET
  3590.     endprotoent();
  3591.     EXTEND(sp,1);
  3592.     RETPUSHYES;
  3593. #else
  3594.     DIE(no_sock_func, "endprotoent");
  3595. #endif
  3596. }
  3597.  
  3598. PP(pp_eservent)
  3599. {
  3600.     dSP;
  3601. #ifdef HAS_SOCKET
  3602.     endservent();
  3603.     EXTEND(sp,1);
  3604.     RETPUSHYES;
  3605. #else
  3606.     DIE(no_sock_func, "endservent");
  3607. #endif
  3608. }
  3609.  
  3610. PP(pp_gpwnam)
  3611. {
  3612. #ifdef HAS_PASSWD
  3613.     return pp_gpwent(ARGS);
  3614. #else
  3615.     DIE(no_func, "getpwnam");
  3616. #endif
  3617. }
  3618.  
  3619. PP(pp_gpwuid)
  3620. {
  3621. #ifdef HAS_PASSWD
  3622.     return pp_gpwent(ARGS);
  3623. #else
  3624.     DIE(no_func, "getpwuid");
  3625. #endif
  3626. }
  3627.  
  3628. PP(pp_gpwent)
  3629. {
  3630.     dSP;
  3631. #ifdef HAS_PASSWD
  3632.     I32 which = op->op_type;
  3633.     register SV *sv;
  3634.     struct passwd *pwent;
  3635.  
  3636.     if (which == OP_GPWNAM)
  3637.     pwent = getpwnam(POPp);
  3638.     else if (which == OP_GPWUID)
  3639.     pwent = getpwuid(POPi);
  3640.     else
  3641.     pwent = (struct passwd *)getpwent();
  3642.  
  3643.     EXTEND(SP, 10);
  3644.     if (GIMME != G_ARRAY) {
  3645.     PUSHs(sv = sv_newmortal());
  3646.     if (pwent) {
  3647.         if (which == OP_GPWNAM)
  3648.         sv_setiv(sv, (I32)pwent->pw_uid);
  3649.         else
  3650.         sv_setpv(sv, pwent->pw_name);
  3651.     }
  3652.     RETURN;
  3653.     }
  3654.  
  3655.     if (pwent) {
  3656.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3657.     sv_setpv(sv, pwent->pw_name);
  3658.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3659.     sv_setpv(sv, pwent->pw_passwd);
  3660.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3661.     sv_setiv(sv, (I32)pwent->pw_uid);
  3662.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3663.     sv_setiv(sv, (I32)pwent->pw_gid);
  3664.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3665. #ifdef PWCHANGE
  3666.     sv_setiv(sv, (I32)pwent->pw_change);
  3667. #else
  3668. #ifdef PWQUOTA
  3669.     sv_setiv(sv, (I32)pwent->pw_quota);
  3670. #else
  3671. #ifdef PWAGE
  3672.     sv_setpv(sv, pwent->pw_age);
  3673. #endif
  3674. #endif
  3675. #endif
  3676.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3677. #ifdef PWCLASS
  3678.     sv_setpv(sv, pwent->pw_class);
  3679. #else
  3680. #ifdef PWCOMMENT
  3681.     sv_setpv(sv, pwent->pw_comment);
  3682. #endif
  3683. #endif
  3684.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3685.     sv_setpv(sv, pwent->pw_gecos);
  3686.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3687.     sv_setpv(sv, pwent->pw_dir);
  3688.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3689.     sv_setpv(sv, pwent->pw_shell);
  3690. #ifdef PWEXPIRE
  3691.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3692.     sv_setiv(sv, (I32)pwent->pw_expire);
  3693. #endif
  3694.     }
  3695.     RETURN;
  3696. #else
  3697.     DIE(no_func, "getpwent");
  3698. #endif
  3699. }
  3700.  
  3701. PP(pp_spwent)
  3702. {
  3703.     dSP;
  3704. #ifdef HAS_PASSWD
  3705.     setpwent();
  3706.     RETPUSHYES;
  3707. #else
  3708.     DIE(no_func, "setpwent");
  3709. #endif
  3710. }
  3711.  
  3712. PP(pp_epwent)
  3713. {
  3714.     dSP;
  3715. #ifdef HAS_PASSWD
  3716.     endpwent();
  3717.     RETPUSHYES;
  3718. #else
  3719.     DIE(no_func, "endpwent");
  3720. #endif
  3721. }
  3722.  
  3723. PP(pp_ggrnam)
  3724. {
  3725. #ifdef HAS_GROUP
  3726.     return pp_ggrent(ARGS);
  3727. #else
  3728.     DIE(no_func, "getgrnam");
  3729. #endif
  3730. }
  3731.  
  3732. PP(pp_ggrgid)
  3733. {
  3734. #ifdef HAS_GROUP
  3735.     return pp_ggrent(ARGS);
  3736. #else
  3737.     DIE(no_func, "getgrgid");
  3738. #endif
  3739. }
  3740.  
  3741. PP(pp_ggrent)
  3742. {
  3743.     dSP;
  3744. #ifdef HAS_GROUP
  3745.     I32 which = op->op_type;
  3746.     register char **elem;
  3747.     register SV *sv;
  3748.     struct group *grent;
  3749.  
  3750.     if (which == OP_GGRNAM)
  3751.     grent = (struct group *)getgrnam(POPp);
  3752.     else if (which == OP_GGRGID)
  3753.     grent = (struct group *)getgrgid(POPi);
  3754.     else
  3755.     grent = (struct group *)getgrent();
  3756.  
  3757.     EXTEND(SP, 4);
  3758.     if (GIMME != G_ARRAY) {
  3759.     PUSHs(sv = sv_newmortal());
  3760.     if (grent) {
  3761.         if (which == OP_GGRNAM)
  3762.         sv_setiv(sv, (I32)grent->gr_gid);
  3763.         else
  3764.         sv_setpv(sv, grent->gr_name);
  3765.     }
  3766.     RETURN;
  3767.     }
  3768.  
  3769.     if (grent) {
  3770.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3771.     sv_setpv(sv, grent->gr_name);
  3772.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3773.     sv_setpv(sv, grent->gr_passwd);
  3774.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3775.     sv_setiv(sv, (I32)grent->gr_gid);
  3776.     PUSHs(sv = sv_mortalcopy(&sv_no));
  3777.     for (elem = grent->gr_mem; *elem; elem++) {
  3778.         sv_catpv(sv, *elem);
  3779.         if (elem[1])
  3780.         sv_catpvn(sv, " ", 1);
  3781.     }
  3782.     }
  3783.  
  3784.     RETURN;
  3785. #else
  3786.     DIE(no_func, "getgrent");
  3787. #endif
  3788. }
  3789.  
  3790. PP(pp_sgrent)
  3791. {
  3792.     dSP;
  3793. #ifdef HAS_GROUP
  3794.     setgrent();
  3795.     RETPUSHYES;
  3796. #else
  3797.     DIE(no_func, "setgrent");
  3798. #endif
  3799. }
  3800.  
  3801. PP(pp_egrent)
  3802. {
  3803.     dSP;
  3804. #ifdef HAS_GROUP
  3805.     endgrent();
  3806.     RETPUSHYES;
  3807. #else
  3808.     DIE(no_func, "endgrent");
  3809. #endif
  3810. }
  3811.  
  3812. PP(pp_getlogin)
  3813. {
  3814.     dSP; dTARGET;
  3815. #ifdef HAS_GETLOGIN
  3816.     char *tmps;
  3817.     EXTEND(SP, 1);
  3818.     if (!(tmps = getlogin()))
  3819.     RETPUSHUNDEF;
  3820.     PUSHp(tmps, strlen(tmps));
  3821.     RETURN;
  3822. #else
  3823.     DIE(no_func, "getlogin");
  3824. #endif
  3825. }
  3826.  
  3827. /* Miscellaneous. */
  3828.  
  3829. PP(pp_syscall)
  3830. {
  3831. #ifdef HAS_SYSCALL
  3832.     dSP; dMARK; dORIGMARK; dTARGET;
  3833.     register I32 items = SP - MARK;
  3834.     unsigned long a[20];
  3835.     register I32 i = 0;
  3836.     I32 retval = -1;
  3837.     MAGIC *mg;
  3838.  
  3839.     if (tainting) {
  3840.     while (++MARK <= SP) {
  3841.         if (SvGMAGICAL(*MARK) && SvSMAGICAL(*MARK) &&
  3842.           (mg = mg_find(*MARK, 't')) && mg->mg_len & 1)
  3843.         tainted = TRUE;
  3844.     }
  3845.     MARK = ORIGMARK;
  3846.     TAINT_PROPER("syscall");
  3847.     }
  3848.  
  3849.     /* This probably won't work on machines where sizeof(long) != sizeof(int)
  3850.      * or where sizeof(long) != sizeof(char*).  But such machines will
  3851.      * not likely have syscall implemented either, so who cares?
  3852.      */
  3853.     while (++MARK <= SP) {
  3854.     if (SvNIOK(*MARK) || !i)
  3855.         a[i++] = SvIV(*MARK);
  3856.     else if (*MARK == &sv_undef)
  3857.         a[i++] = 0;
  3858.     else
  3859.         a[i++] = (unsigned long)SvPV_force(*MARK, na);
  3860.     if (i > 15)
  3861.         break;
  3862.     }
  3863.     switch (items) {
  3864.     default:
  3865.     DIE("Too many args to syscall");
  3866.     case 0:
  3867.     DIE("Too few args to syscall");
  3868.     case 1:
  3869.     retval = syscall(a[0]);
  3870.     break;
  3871.     case 2:
  3872.     retval = syscall(a[0],a[1]);
  3873.     break;
  3874.     case 3:
  3875.     retval = syscall(a[0],a[1],a[2]);
  3876.     break;
  3877.     case 4:
  3878.     retval = syscall(a[0],a[1],a[2],a[3]);
  3879.     break;
  3880.     case 5:
  3881.     retval = syscall(a[0],a[1],a[2],a[3],a[4]);
  3882.     break;
  3883.     case 6:
  3884.     retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5]);
  3885.     break;
  3886.     case 7:
  3887.     retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6]);
  3888.     break;
  3889.     case 8:
  3890.     retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7]);
  3891.     break;
  3892. #ifdef atarist
  3893.     case 9:
  3894.     retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8]);
  3895.     break;
  3896.     case 10:
  3897.     retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9]);
  3898.     break;
  3899.     case 11:
  3900.     retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
  3901.       a[10]);
  3902.     break;
  3903.     case 12:
  3904.     retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
  3905.       a[10],a[11]);
  3906.     break;
  3907.     case 13:
  3908.     retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
  3909.       a[10],a[11],a[12]);
  3910.     break;
  3911.     case 14:
  3912.     retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],
  3913.       a[10],a[11],a[12],a[13]);
  3914.     break;
  3915. #endif /* atarist */
  3916.     }
  3917.     SP = ORIGMARK;
  3918.     PUSHi(retval);
  3919.     RETURN;
  3920. #else
  3921.     DIE(no_func, "syscall");
  3922. #endif
  3923. }
  3924.  
  3925.